[OCaml] Expose Llvm_executionengine.ExecutionEngine.create_mcjit.

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@220619 91177308-0d34-0410-b5e6-96231b3b80d8

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

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
 

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

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