mirror of
https://github.com/RPCSX/llvm.git
synced 2024-11-24 12:19:53 +00:00
[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:
parent
71fe4f0197
commit
60d3f5918d
@ -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);
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
()
|
||||
|
Loading…
Reference in New Issue
Block a user