From 60d3f5918dfa3c23d0bcf60cb73fa609f95d970e Mon Sep 17 00:00:00 2001 From: Peter Zotov Date: Sat, 25 Oct 2014 18:49:56 +0000 Subject: [PATCH] [OCaml] Expose Llvm_executionengine.ExecutionEngine.create_mcjit. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@220619 91177308-0d34-0410-b5e6-96231b3b80d8 --- .../executionengine/executionengine_ocaml.c | 18 +++++ .../executionengine/llvm_executionengine.ml | 43 +++++++++--- .../executionengine/llvm_executionengine.mli | 69 ++++++++++++++----- test/Bindings/Ocaml/executionengine.ml | 65 ++++++++++------- 4 files changed, 142 insertions(+), 53 deletions(-) diff --git a/bindings/ocaml/executionengine/executionengine_ocaml.c b/bindings/ocaml/executionengine/executionengine_ocaml.c index 4896c74121b..49e64f39266 100644 --- a/bindings/ocaml/executionengine/executionengine_ocaml.c +++ b/bindings/ocaml/executionengine/executionengine_ocaml.c @@ -200,6 +200,24 @@ llvm_ee_create_jit(LLVMModuleRef M, value OptLevel) { return JIT; } +/* llmodule -> llcompileroption -> ExecutionEngine.t */ +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 + }; + if (LLVMCreateMCJITCompilerForModule(&MCJIT, M, &Options, + sizeof(Options), &Error)) + llvm_raise(llvm_ee_error_exn, Error); + return MCJIT; +} + /* ExecutionEngine.t -> unit */ CAMLprim value llvm_ee_dispose(LLVMExecutionEngineRef EE) { LLVMDisposeExecutionEngine(EE); diff --git a/bindings/ocaml/executionengine/llvm_executionengine.ml b/bindings/ocaml/executionengine/llvm_executionengine.ml index a738df765dc..2165533c137 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.ml +++ b/bindings/ocaml/executionengine/llvm_executionengine.ml @@ -14,9 +14,19 @@ external register_exns: exn -> unit = "llvm_register_ee_exns" +module CodeModel = struct + type t = + | Default + | JIT_default + | Small + | Kernel + | Medium + | Large +end + module GenericValue = struct type t - + external of_float: Llvm.lltype -> float -> t = "llvm_genericvalue_of_float" external of_pointer: 'a -> t @@ -29,7 +39,7 @@ module GenericValue = struct = "llvm_genericvalue_of_nativeint" external of_int64: Llvm.lltype -> int64 -> t = "llvm_genericvalue_of_int64" - + external as_float: Llvm.lltype -> t -> float = "llvm_genericvalue_as_float" external as_pointer: t -> 'a @@ -47,21 +57,36 @@ end module ExecutionEngine = struct type t - + + type compileroptions = { + opt_level: int; + code_model: CodeModel.t; + no_framepointer_elim: bool; + enable_fast_isel: bool; + } + + let default_compiler_options = { + opt_level = 0; + code_model = CodeModel.JIT_default; + 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 + 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 + 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 = "llvm_ee_create_interpreter" external create_jit: Llvm.llmodule -> int -> t = "llvm_ee_create_jit" + external create_mcjit: Llvm.llmodule -> compileroptions -> t + = "llvm_ee_create_mcjit" external dispose: t -> unit = "llvm_ee_dispose" external add_module: Llvm.llmodule -> t -> unit @@ -85,9 +110,9 @@ module ExecutionEngine = struct external data_layout : t -> Llvm_target.DataLayout.t = "llvm_ee_get_data_layout" - + (* The following are not bound. Patches are welcome. - + add_global_mapping: llvalue -> llgenericvalue -> t -> unit clear_all_global_mappings: t -> unit update_global_mapping: llvalue -> llgenericvalue -> t -> unit @@ -103,7 +128,7 @@ module ExecutionEngine = struct disable_lazy_compilation: t -> unit lazy_compilation_enabled: t -> bool install_lazy_function_creator: (string -> llgenericvalue) -> t -> unit - + *) end diff --git a/bindings/ocaml/executionengine/llvm_executionengine.mli b/bindings/ocaml/executionengine/llvm_executionengine.mli index 74a606287f4..0b55193b6e5 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.mli +++ b/bindings/ocaml/executionengine/llvm_executionengine.mli @@ -14,6 +14,17 @@ exception Error of string +(** The JIT code model. See [llvm::CodeModel::Model]. *) +module CodeModel : sig + type t = + | Default + | JIT_default + | Small + | Kernel + | Medium + | Large +end + module GenericValue: sig (** [GenericValue.t] is a boxed union type used to portably pass arguments to and receive values from the execution engine. It supports only a limited @@ -21,24 +32,24 @@ module GenericValue: sig generate a stub function by hand or to pass parameters by reference. See the struct [llvm::GenericValue]. *) type t - + (** [of_float fpty n] boxes the float [n] in a float-valued generic value according to the floating point type [fpty]. See the fields [llvm::GenericValue::DoubleVal] and [llvm::GenericValue::FloatVal]. *) val of_float : Llvm.lltype -> float -> t - + (** [of_pointer v] boxes the pointer value [v] in a generic value. See the field [llvm::GenericValue::PointerVal]. *) val of_pointer : 'a -> t - + (** [of_int32 n w] boxes the int32 [i] in a generic value with the bitwidth [w]. See the field [llvm::GenericValue::IntVal]. *) val of_int32 : Llvm.lltype -> int32 -> t - + (** [of_int n w] boxes the int [i] in a generic value with the bitwidth [w]. See the field [llvm::GenericValue::IntVal]. *) val of_int : Llvm.lltype -> int -> t - + (** [of_natint n w] boxes the native int [i] in a generic value with the bitwidth [w]. See the field [llvm::GenericValue::IntVal]. *) val of_nativeint : Llvm.lltype -> nativeint -> t @@ -51,27 +62,27 @@ module GenericValue: sig floating point type [fpty]. See the fields [llvm::GenericValue::DoubleVal] and [llvm::GenericValue::FloatVal]. *) val as_float : Llvm.lltype -> t -> float - + (** [as_pointer gv] unboxes the pointer-valued generic value [gv]. See the field [llvm::GenericValue::PointerVal]. *) val as_pointer : t -> 'a - + (** [as_int32 gv] unboxes the integer-valued generic value [gv] as an [int32]. Is invalid if [gv] has a bitwidth greater than 32 bits. See the field [llvm::GenericValue::IntVal]. *) val as_int32 : t -> int32 - + (** [as_int gv] unboxes the integer-valued generic value [gv] as an [int]. Is invalid if [gv] has a bitwidth greater than the host bit width (but the most significant bit may be lost). See the field [llvm::GenericValue::IntVal]. *) val as_int : t -> int - + (** [as_natint gv] unboxes the integer-valued generic value [gv] as a [nativeint]. Is invalid if [gv] has a bitwidth greater than [nativeint]. See the field [llvm::GenericValue::IntVal]. *) val as_nativeint : t -> nativeint - + (** [as_int64 gv] returns the integer-valued generic value [gv] as an [int64]. Is invalid if [gv] has a bitwidth greater than [int64]. See the field [llvm::GenericValue::IntVal]. *) @@ -84,35 +95,57 @@ module ExecutionEngine: sig directly loading an LLVM module and executing its functions without first invoking a static compiler and generating a native executable. *) type t - + + (** MCJIT compiler options. See [llvm::TargetOptions]. *) + type compileroptions = { + opt_level: int; + code_model: CodeModel.t; + no_framepointer_elim: bool; + enable_fast_isel: bool; + } + + (** Default MCJIT compiler options: + [{ opt_level = 0; code_model = CodeModel.JIT_default; + no_framepointer_elim = false; enable_fast_isel = false }] *) + val default_compiler_options : compileroptions + (** [create m] creates a new execution engine, taking ownership of the module [m] if successful. Creates a JIT if possible, else falls back to an interpreter. Raises [Error msg] if an error occurrs. The execution engine is not garbage collected and must be destroyed with [dispose ee]. See the function [llvm::EngineBuilder::create]. *) val create : Llvm.llmodule -> t - + (** [create_interpreter m] creates a new interpreter, taking ownership of the module [m] if successful. Raises [Error msg] if an error occurrs. The execution engine is not garbage collected and must be destroyed with [dispose ee]. See the function [llvm::EngineBuilder::create]. *) val create_interpreter : Llvm.llmodule -> t - + (** [create_jit m optlevel] creates a new JIT (just-in-time compiler), taking ownership of the module [m] if successful with the desired optimization level [optlevel]. Raises [Error msg] if an error occurrs. The execution engine is not garbage collected and must be destroyed with [dispose ee]. - See the function [llvm::EngineBuilder::create]. *) + See the function [llvm::EngineBuilder::create]. + + Deprecated; use {!create_mcjit}. This function is a shim for {!create_mcjit}. *) val create_jit : Llvm.llmodule -> int -> t + (** [create_jit m optlevel] creates a new JIT (just-in-time compiler), taking + ownership of the module [m] if successful with the desired optimization + level [optlevel]. Raises [Error msg] if an error occurrs. The execution + engine is not garbage collected and must be destroyed with [dispose ee]. + See the function [llvm::EngineBuilder::create]. *) + val create_mcjit : Llvm.llmodule -> compileroptions -> t + (** [dispose ee] releases the memory used by the execution engine and must be invoked to avoid memory leaks. *) val dispose : t -> unit (** [add_module m ee] adds the module [m] to the execution engine [ee]. *) val add_module : Llvm.llmodule -> t -> unit - + (** [remove_module m ee] removes the module [m] from the execution engine [ee], disposing of [m] and the module referenced by [mp]. Raises [Error msg] if an error occurs. *) @@ -122,7 +155,7 @@ module ExecutionEngine: sig modules owned by the execution engine [ee]. Returns [None] if the function is not found and [Some f] otherwise. *) val find_function : string -> t -> Llvm.llvalue option - + (** [run_function f args ee] synchronously executes the function [f] with the arguments [args], which must be compatible with the parameter types. *) val run_function : Llvm.llvalue -> GenericValue.t array -> t -> @@ -131,11 +164,11 @@ module ExecutionEngine: sig (** [run_static_ctors ee] executes the static constructors of each module in the execution engine [ee]. *) val run_static_ctors : t -> unit - + (** [run_static_dtors ee] executes the static destructors of each module in the execution engine [ee]. *) val run_static_dtors : t -> unit - + (** [run_function_as_main f args env ee] executes the function [f] as a main function, passing it [argv] and [argc] according to the string array [args], and [envp] as specified by the array [env]. Returns the integer diff --git a/test/Bindings/Ocaml/executionengine.ml b/test/Bindings/Ocaml/executionengine.ml index 8e2494952a2..84604ddbaec 100644 --- a/test/Bindings/Ocaml/executionengine.ml +++ b/test/Bindings/Ocaml/executionengine.ml @@ -44,62 +44,72 @@ let test_genericvalue () = let tu = (1, 2) in let ptrgv = GenericValue.of_pointer tu in assert (tu = GenericValue.as_pointer ptrgv); - + let fpgv = GenericValue.of_float double_type 2. in assert (2. = GenericValue.as_float double_type fpgv); - + let intgv = GenericValue.of_int i32_type 3 in assert (3 = GenericValue.as_int intgv); - + let i32gv = GenericValue.of_int32 i32_type (Int32.of_int 4) in assert ((Int32.of_int 4) = GenericValue.as_int32 i32gv); - + let nigv = GenericValue.of_nativeint i32_type (Nativeint.of_int 5) in assert ((Nativeint.of_int 5) = GenericValue.as_nativeint nigv); - + let i64gv = GenericValue.of_int64 i64_type (Int64.of_int 6) in assert ((Int64.of_int 6) = GenericValue.as_int64 i64gv) -let test_executionengine () = +let test_executionengine engine = (* create *) let m = create_module (global_context ()) "test_module" in let main = define_main_fn m 42 in - + let m2 = create_module (global_context ()) "test_module2" in define_plus m2; - - let ee = ExecutionEngine.create m in + + let ee = + match engine with + | `Interpreter -> ExecutionEngine.create_interpreter m + | `JIT -> ExecutionEngine.create_jit m 0 + | `MCJIT -> ExecutionEngine.create_mcjit m ExecutionEngine.default_compiler_options + in ExecutionEngine.add_module m2 ee; - + (* run_static_ctors *) ExecutionEngine.run_static_ctors ee; - + (* run_function_as_main *) let res = ExecutionEngine.run_function_as_main main [|"test"|] [||] ee in if 42 != res then bomb "main did not return 42"; - + (* free_machine_code *) ExecutionEngine.free_machine_code main ee; - + (* find_function *) match ExecutionEngine.find_function "dne" ee with | Some _ -> raise (Failure "find_function 'dne' failed") | None -> - + match ExecutionEngine.find_function "plus" ee with | None -> raise (Failure "find_function 'plus' failed") | Some plus -> - - (* run_function *) - let res = ExecutionEngine.run_function plus - [| GenericValue.of_int i32_type 2; - GenericValue.of_int i32_type 2 |] - ee in - if 4 != GenericValue.as_int res then bomb "plus did not work"; - + + begin match engine with + | `MCJIT -> () (* Currently can only invoke 0-ary functions *) + | `JIT -> () (* JIT is now a shim around MCJIT, jokes on you *) + | _ -> + (* run_function *) + let res = ExecutionEngine.run_function plus + [| GenericValue.of_int i32_type 2; + GenericValue.of_int i32_type 2 |] + ee in + if 4 != GenericValue.as_int res then bomb "plus did not work"; + end; + (* remove_module *) Llvm.dispose_module (ExecutionEngine.remove_module m2 ee); - + (* run_static_dtors *) ExecutionEngine.run_static_dtors ee; @@ -109,10 +119,13 @@ let test_executionengine () = (* Demonstrate that a garbage pointer wasn't returned. *) let ty = DataLayout.intptr_type context dl in if ty != i32_type && ty != i64_type then bomb "target_data did not work"; - + (* dispose *) ExecutionEngine.dispose ee -let _ = +let () = test_genericvalue (); - test_executionengine () + test_executionengine `Interpreter; + test_executionengine `JIT; + test_executionengine `MCJIT; + () -- 2.34.1