[OCaml] Rework Llvm_executionengine using ctypes.
[oota-llvm.git] / bindings / ocaml / executionengine / llvm_executionengine.ml
index cf9acc7cb6b8297b4a0ea32d00f90290ea711337..c0ff3308dd095b3c8eaf3d41d3627b30cb2e8ffe 100644 (file)
@@ -1,4 +1,4 @@
-(*===-- llvm_executionengine.ml - LLVM Ocaml Interface ----------*- C++ -*-===*
+(*===-- llvm_executionengine.ml - LLVM OCaml Interface --------*- OCaml -*-===*
  *
  *                     The LLVM Compiler Infrastructure
  *
  *
  *                     The LLVM Compiler Infrastructure
  *
  *
  *===----------------------------------------------------------------------===*)
 
  *
  *===----------------------------------------------------------------------===*)
 
-
 exception Error of string
 
 exception Error of string
 
-external register_exns: exn -> unit
-  = "llvm_register_ee_exns"
-
-
-module GenericValue = struct
-  type t
-  
-  external of_float: Llvm.lltype -> float -> t
-    = "llvm_genericvalue_of_float"
-  external of_pointer: 'a -> t
-    = "llvm_genericvalue_of_value"
-  external of_int32: Llvm.lltype -> int32 -> t
-    = "llvm_genericvalue_of_int32"
-  external of_int: Llvm.lltype -> int -> t
-    = "llvm_genericvalue_of_int"
-  external of_nativeint: Llvm.lltype -> nativeint -> t
-    = "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
-    = "llvm_genericvalue_as_value"
-  external as_int32: t -> int32
-    = "llvm_genericvalue_as_int32"
-  external as_int: t -> int
-    = "llvm_genericvalue_as_int"
-  external as_nativeint: t -> nativeint
-    = "llvm_genericvalue_as_nativeint"
-  external as_int64: t -> int64
-    = "llvm_genericvalue_as_int64"
-end
-
-
-module ExecutionEngine = struct
-  type t
-  
-  (* 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 
-            ocaml_executionengine.c. This is hardly fatal, but it is unnecessary
-            overhead on top of the two stubs that are already invoked for each 
-            call into LLVM. *)
-  let _ = register_exns (Error "")
-  
-  external create: Llvm.llmoduleprovider -> t
-    = "llvm_ee_create"
-  external create_interpreter: Llvm.llmoduleprovider -> t
-    = "llvm_ee_create_interpreter"
-  external create_jit: Llvm.llmoduleprovider -> t
-    = "llvm_ee_create_jit"
-  external create_fast_jit: Llvm.llmoduleprovider -> t
-    = "llvm_ee_create_fast_jit"
-  external dispose: t -> unit
-    = "llvm_ee_dispose"
-  external add_module_provider: Llvm.llmoduleprovider -> t -> unit
-    = "llvm_ee_add_mp"
-  external remove_module_provider: Llvm.llmoduleprovider -> t -> Llvm.llmodule
-    = "llvm_ee_remove_mp"
-  external find_function: string -> t -> Llvm.llvalue option
-    = "llvm_ee_find_function"
-  external run_function: Llvm.llvalue -> GenericValue.t array -> t ->
-                         GenericValue.t
-    = "llvm_ee_run_function"
-  external run_static_ctors: t -> unit
-    = "llvm_ee_run_static_ctors"
-  external run_static_dtors: t -> unit
-    = "llvm_ee_run_static_dtors"
-  external run_function_as_main: Llvm.llvalue -> string array ->
-                                 (string * string) array -> t -> int
-    = "llvm_ee_run_function_as_main"
-  external free_machine_code: Llvm.llvalue -> t -> unit
-    = "llvm_ee_free_machine_code"
-
-  external target_data: t -> Llvm_target.TargetData.t
-    = "LLVMGetExecutionEngineTargetData"
-  
-  (* The following are not bound. Patches are welcome.
-  
-  get_target_data: t -> lltargetdata
-  add_global_mapping: llvalue -> llgenericvalue -> t -> unit
-  clear_all_global_mappings: t -> unit
-  update_global_mapping: llvalue -> llgenericvalue -> t -> unit
-  get_pointer_to_global_if_available: llvalue -> t -> llgenericvalue
-  get_pointer_to_global: llvalue -> t -> llgenericvalue
-  get_pointer_to_function: llvalue -> t -> llgenericvalue
-  get_pointer_to_function_or_stub: llvalue -> t -> llgenericvalue
-  get_global_value_at_address: llgenericvalue -> t -> llvalue option
-  store_value_to_memory: llgenericvalue -> llgenericvalue -> lltype -> unit
-  initialize_memory: llvalue -> llgenericvalue -> t -> unit
-  recompile_and_relink_function: llvalue -> t -> llgenericvalue
-  get_or_emit_global_variable: llvalue -> t -> llgenericvalue
-  disable_lazy_compilation: t -> unit
-  lazy_compilation_enabled: t -> bool
-  install_lazy_function_creator: (string -> llgenericvalue) -> t -> unit
-  
-   *)
-end
+let () = Callback.register_exception "Llvm_executionengine.Error" (Error "")
+
+external initialize : unit -> bool
+  = "llvm_ee_initialize"
+
+type llexecutionengine
+
+type llcompileroptions = {
+  opt_level: int;
+  code_model: Llvm_target.CodeModel.t;
+  no_framepointer_elim: bool;
+  enable_fast_isel: bool;
+}
+
+let default_compiler_options = {
+  opt_level = 0;
+  code_model = Llvm_target.CodeModel.JITDefault;
+  no_framepointer_elim = false;
+  enable_fast_isel = false }
+
+external create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine
+  = "llvm_ee_create"
+external dispose : llexecutionengine -> unit
+  = "llvm_ee_dispose"
+external add_module : Llvm.llmodule -> llexecutionengine -> unit
+  = "llvm_ee_add_module"
+external remove_module : Llvm.llmodule -> llexecutionengine -> unit
+  = "llvm_ee_remove_module"
+external run_static_ctors : llexecutionengine -> unit
+  = "llvm_ee_run_static_ctors"
+external run_static_dtors : llexecutionengine -> unit
+  = "llvm_ee_run_static_dtors"
+external data_layout : llexecutionengine -> Llvm_target.DataLayout.t
+  = "llvm_ee_get_data_layout"
+external add_global_mapping_ : Llvm.llvalue -> int64 -> llexecutionengine -> unit
+  = "llvm_ee_add_global_mapping"
+external get_pointer_to_global_ : Llvm.llvalue -> llexecutionengine -> int64
+  = "llvm_ee_get_pointer_to_global"
+
+let add_global_mapping llval ptr ee =
+  add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee
+
+let get_pointer_to_global llval typ ee =
+  Ctypes.coerce (let open Ctypes in ptr void) typ
+                (Ctypes.ptr_of_raw_address (get_pointer_to_global_ llval ee))
+
+(* The following are not bound. Patches are welcome.
+target_machine : llexecutionengine -> Llvm_target.TargetMachine.t
+ *)