[llvm] r220619 - [OCaml] Expose Llvm_executionengine.ExecutionEngine.create_mcjit.
Peter Zotov
whitequark at whitequark.org
Sat Oct 25 11:49:56 PDT 2014
Author: whitequark
Date: Sat Oct 25 13:49:56 2014
New Revision: 220619
URL: http://llvm.org/viewvc/llvm-project?rev=220619&view=rev
Log:
[OCaml] Expose Llvm_executionengine.ExecutionEngine.create_mcjit.
Modified:
llvm/trunk/bindings/ocaml/executionengine/executionengine_ocaml.c
llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.ml
llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.mli
llvm/trunk/test/Bindings/Ocaml/executionengine.ml
Modified: llvm/trunk/bindings/ocaml/executionengine/executionengine_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/executionengine/executionengine_ocaml.c?rev=220619&r1=220618&r2=220619&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/executionengine/executionengine_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/executionengine/executionengine_ocaml.c Sat Oct 25 13:49:56 2014
@@ -200,6 +200,24 @@ llvm_ee_create_jit(LLVMModuleRef M, valu
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);
Modified: llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.ml?rev=220619&r1=220618&r2=220619&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.ml (original)
+++ llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.ml Sat Oct 25 13:49:56 2014
@@ -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
Modified: llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.mli?rev=220619&r1=220618&r2=220619&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.mli (original)
+++ llvm/trunk/bindings/ocaml/executionengine/llvm_executionengine.mli Sat Oct 25 13:49:56 2014
@@ -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
Modified: llvm/trunk/test/Bindings/Ocaml/executionengine.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/executionengine.ml?rev=220619&r1=220618&r2=220619&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/executionengine.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/executionengine.ml Sat Oct 25 13:49:56 2014
@@ -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;
+ ()
More information about the llvm-commits
mailing list