[OCaml] Expose Llvm_executionengine.ExecutionEngine.create_mcjit.

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@220619 91177308-0d34-0410-b5e6-96231b3b80d8
This commit is contained in:
Peter Zotov 2014-10-25 18:49:56 +00:00
parent 71fe4f0197
commit 60d3f5918d
4 changed files with 142 additions and 53 deletions

View File

@ -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);

View File

@ -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

View File

@ -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,27 +95,49 @@ 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].
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_jit : Llvm.llmodule -> int -> t
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. *)
@ -112,7 +145,7 @@ module ExecutionEngine: sig
(** [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

View File

@ -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;
()