diff options
Diffstat (limited to 'llvm/bindings/ocaml/executionengine')
4 files changed, 50 insertions, 77 deletions
diff --git a/llvm/bindings/ocaml/executionengine/Makefile b/llvm/bindings/ocaml/executionengine/Makefile index d915a76e1ff..6c2bd2a8d61 100644 --- a/llvm/bindings/ocaml/executionengine/Makefile +++ b/llvm/bindings/ocaml/executionengine/Makefile @@ -1,4 +1,4 @@ -##===- bindings/ocaml/executionengine/Makefile --------------*- Makefile -*-===## +##===- bindings/ocaml/executionengine/Makefile -------------*- Makefile -*-===## # # The LLVM Compiler Infrastructure # diff --git a/llvm/bindings/ocaml/executionengine/executionengine_ocaml.c b/llvm/bindings/ocaml/executionengine/executionengine_ocaml.c index 8388233a356..a12cc0091ae 100644 --- a/llvm/bindings/ocaml/executionengine/executionengine_ocaml.c +++ b/llvm/bindings/ocaml/executionengine/executionengine_ocaml.c @@ -15,37 +15,15 @@ |* *| \*===----------------------------------------------------------------------===*/ +#include <string.h> +#include <assert.h> #include "llvm-c/ExecutionEngine.h" #include "llvm-c/Target.h" #include "caml/alloc.h" #include "caml/custom.h" #include "caml/fail.h" #include "caml/memory.h" -#include <string.h> -#include <assert.h> - -/* Force the LLVM interpreter and JIT to be linked in. */ -void llvm_initialize(void) { - LLVMLinkInInterpreter(); - LLVMLinkInMCJIT(); -} - -/* unit -> bool */ -CAMLprim value llvm_initialize_native_target(value Unit) { - return Val_bool(!LLVMInitializeNativeTarget() && - !LLVMInitializeNativeAsmParser() && - !LLVMInitializeNativeAsmPrinter()); -} - -/* Can't use the recommended caml_named_value mechanism for backwards - compatibility reasons. This is largely equivalent. */ -static value llvm_ee_error_exn; - -CAMLprim value llvm_register_ee_exns(value Error) { - llvm_ee_error_exn = Field(Error, 0); - register_global_root(&llvm_ee_error_exn); - return Val_unit; -} +#include "caml/callback.h" static void llvm_raise(value Prototype, char *Message) { CAMLparam1(Prototype); @@ -55,13 +33,9 @@ static void llvm_raise(value Prototype, char *Message) { LLVMDisposeMessage(Message); raise_with_arg(Prototype, CamlMessage); - abort(); /* NOTREACHED */ -#ifdef CAMLnoreturn - CAMLnoreturn; /* Silences warnings, but is missing in some versions. */ -#endif + CAMLnoreturn; } - /*--... Operations on generic values .......................................--*/ #define Genericvalue_val(v) (*(LLVMGenericValueRef *)(Data_custom_val(v))) @@ -71,15 +45,13 @@ static void llvm_finalize_generic_value(value GenVal) { } static struct custom_operations generic_value_ops = { - (char *) "LLVMGenericValue", + (char *) "Llvm_executionengine.GenericValue.t", llvm_finalize_generic_value, custom_compare_default, custom_hash_default, custom_serialize_default, - custom_deserialize_default -#ifdef custom_compare_ext_default - , custom_compare_ext_default -#endif + custom_deserialize_default, + custom_compare_ext_default }; static value alloc_generic_value(LLVMGenericValueRef Ref) { @@ -173,12 +145,22 @@ CAMLprim value llvm_genericvalue_as_nativeint(value GenVal) { /*--... Operations on execution engines ....................................--*/ +/* unit -> bool */ +CAMLprim value llvm_initialize_native_target(value Unit) { + LLVMLinkInInterpreter(); + LLVMLinkInMCJIT(); + + return Val_bool(!LLVMInitializeNativeTarget() && + !LLVMInitializeNativeAsmParser() && + !LLVMInitializeNativeAsmPrinter()); +} + /* llmodule -> ExecutionEngine.t */ CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleRef M) { LLVMExecutionEngineRef Interp; char *Error; if (LLVMCreateExecutionEngineForModule(&Interp, M, &Error)) - llvm_raise(llvm_ee_error_exn, Error); + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return Interp; } @@ -188,7 +170,7 @@ llvm_ee_create_interpreter(LLVMModuleRef M) { LLVMExecutionEngineRef Interp; char *Error; if (LLVMCreateInterpreterForModule(&Interp, M, &Error)) - llvm_raise(llvm_ee_error_exn, Error); + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return Interp; } @@ -198,7 +180,7 @@ llvm_ee_create_jit(LLVMModuleRef M, value OptLevel) { LLVMExecutionEngineRef JIT; char *Error; if (LLVMCreateJITCompilerForModule(&JIT, M, Int_val(OptLevel), &Error)) - llvm_raise(llvm_ee_error_exn, Error); + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return JIT; } @@ -207,16 +189,18 @@ CAMLprim LLVMExecutionEngineRef llvm_ee_create_mcjit(LLVMModuleRef M, value OptRecord) { LLVMExecutionEngineRef MCJIT; char *Error; - struct LLVMMCJITCompilerOptions Options = { - .OptLevel = Int_val(Field(OptRecord, 0)), - .CodeModel = Int_val(Field(OptRecord, 1)), - .NoFramePointerElim = Int_val(Field(OptRecord, 2)), - .EnableFastISel = Int_val(Field(OptRecord, 3)), - .MCJMM = NULL - }; + struct LLVMMCJITCompilerOptions Options; + + LLVMInitializeMCJITCompilerOptions(&Options, sizeof(Options)); + Options.OptLevel = Int_val(Field(OptRecord, 0)); + Options.CodeModel = Int_val(Field(OptRecord, 1)); + Options.NoFramePointerElim = Int_val(Field(OptRecord, 2)); + Options.EnableFastISel = Int_val(Field(OptRecord, 3)); + Options.MCJMM = NULL; + if (LLVMCreateMCJITCompilerForModule(&MCJIT, M, &Options, sizeof(Options), &Error)) - llvm_raise(llvm_ee_error_exn, Error); + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return MCJIT; } @@ -238,7 +222,7 @@ CAMLprim LLVMModuleRef llvm_ee_remove_module(LLVMModuleRef M, LLVMModuleRef RemovedModule; char *Error; if (LLVMRemoveModule(EE, M, &RemovedModule, &Error)) - llvm_raise(llvm_ee_error_exn, Error); + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return RemovedModule; } @@ -350,9 +334,9 @@ extern value llvm_alloc_data_layout(LLVMTargetDataRef TargetData); CAMLprim value llvm_ee_get_data_layout(LLVMExecutionEngineRef EE) { value DataLayout; LLVMTargetDataRef OrigDataLayout; - OrigDataLayout = LLVMGetExecutionEngineTargetData(EE); - char* TargetDataCStr; + + OrigDataLayout = LLVMGetExecutionEngineTargetData(EE); TargetDataCStr = LLVMCopyStringRepOfTargetData(OrigDataLayout); DataLayout = llvm_alloc_data_layout(LLVMCreateTargetData(TargetDataCStr)); LLVMDisposeMessage(TargetDataCStr); diff --git a/llvm/bindings/ocaml/executionengine/llvm_executionengine.ml b/llvm/bindings/ocaml/executionengine/llvm_executionengine.ml index 2165533c137..f61195337ca 100644 --- a/llvm/bindings/ocaml/executionengine/llvm_executionengine.ml +++ b/llvm/bindings/ocaml/executionengine/llvm_executionengine.ml @@ -1,4 +1,4 @@ -(*===-- llvm_executionengine.ml - LLVM OCaml Interface ----------*- C++ -*-===* +(*===-- llvm_executionengine.ml - LLVM OCaml Interface --------*- OCaml -*-===* * * The LLVM Compiler Infrastructure * @@ -7,21 +7,18 @@ * *===----------------------------------------------------------------------===*) - exception Error of string -external register_exns: exn -> unit - = "llvm_register_ee_exns" - +let () = Callback.register_exception "Llvm_executionengine.Error" (Error "") module CodeModel = struct type t = - | Default - | JIT_default - | Small - | Kernel - | Medium - | Large + | Default + | JIT_default + | Small + | Kernel + | Medium + | Large end module GenericValue = struct @@ -71,14 +68,6 @@ module ExecutionEngine = struct no_framepointer_elim = false; enable_fast_isel = false } - (* FIXME: Ocaml is not running this setup code unless we use 'val' in the - interface, which causes the emission of a stub for each function; - using 'external' in the module allows direct calls into - ocaml_executionengine.c. This is hardly fatal, but it is unnecessary - overhead on top of the two stubs that are already invoked for each - call into LLVM. *) - let _ = register_exns (Error "") - external create: Llvm.llmodule -> t = "llvm_ee_create" external create_interpreter: Llvm.llmodule -> t diff --git a/llvm/bindings/ocaml/executionengine/llvm_executionengine.mli b/llvm/bindings/ocaml/executionengine/llvm_executionengine.mli index 0b55193b6e5..772e2e574b8 100644 --- a/llvm/bindings/ocaml/executionengine/llvm_executionengine.mli +++ b/llvm/bindings/ocaml/executionengine/llvm_executionengine.mli @@ -1,4 +1,4 @@ -(*===-- llvm_executionengine.mli - LLVM OCaml Interface ---------*- C++ -*-===* +(*===-- llvm_executionengine.mli - LLVM OCaml Interface -------*- OCaml -*-===* * * The LLVM Compiler Infrastructure * @@ -10,19 +10,19 @@ (** JIT Interpreter. This interface provides an OCaml API for LLVM execution engine (JIT/ - interpreter), the classes in the ExecutionEngine library. *) + interpreter), the classes in the [ExecutionEngine] library. *) exception Error of string (** The JIT code model. See [llvm::CodeModel::Model]. *) module CodeModel : sig type t = - | Default - | JIT_default - | Small - | Kernel - | Medium - | Large + | Default + | JIT_default + | Small + | Kernel + | Medium + | Large end module GenericValue: sig |