1(*===-- llvm_executionengine.ml - LLVM OCaml Interface --------*- OCaml -*-===* 2 * 3 * The LLVM Compiler Infrastructure 4 * 5 * This file is distributed under the University of Illinois Open Source 6 * License. See LICENSE.TXT for details. 7 * 8 *===----------------------------------------------------------------------===*) 9 10exception Error of string 11 12let () = Callback.register_exception "Llvm_executionengine.Error" (Error "") 13 14external initialize : unit -> bool 15 = "llvm_ee_initialize" 16 17type llexecutionengine 18 19type llcompileroptions = { 20 opt_level: int; 21 code_model: Llvm_target.CodeModel.t; 22 no_framepointer_elim: bool; 23 enable_fast_isel: bool; 24} 25 26let default_compiler_options = { 27 opt_level = 0; 28 code_model = Llvm_target.CodeModel.JITDefault; 29 no_framepointer_elim = false; 30 enable_fast_isel = false } 31 32external create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine 33 = "llvm_ee_create" 34external dispose : llexecutionengine -> unit 35 = "llvm_ee_dispose" 36external add_module : Llvm.llmodule -> llexecutionengine -> unit 37 = "llvm_ee_add_module" 38external remove_module : Llvm.llmodule -> llexecutionengine -> unit 39 = "llvm_ee_remove_module" 40external run_static_ctors : llexecutionengine -> unit 41 = "llvm_ee_run_static_ctors" 42external run_static_dtors : llexecutionengine -> unit 43 = "llvm_ee_run_static_dtors" 44external data_layout : llexecutionengine -> Llvm_target.DataLayout.t 45 = "llvm_ee_get_data_layout" 46external add_global_mapping_ : Llvm.llvalue -> nativeint -> llexecutionengine -> unit 47 = "llvm_ee_add_global_mapping" 48external get_global_value_address_ : string -> llexecutionengine -> nativeint 49 = "llvm_ee_get_global_value_address" 50external get_function_address_ : string -> llexecutionengine -> nativeint 51 = "llvm_ee_get_function_address" 52 53let add_global_mapping llval ptr ee = 54 add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee 55 56let get_global_value_address name typ ee = 57 let vptr = get_global_value_address_ name ee in 58 if Nativeint.to_int vptr <> 0 then 59 let open Ctypes in !@ (coerce (ptr void) (ptr typ) (ptr_of_raw_address vptr)) 60 else 61 raise (Error ("Value " ^ name ^ " not found")) 62 63let get_function_address name typ ee = 64 let fptr = get_function_address_ name ee in 65 if Nativeint.to_int fptr <> 0 then 66 let open Ctypes in coerce (ptr void) typ (ptr_of_raw_address fptr) 67 else 68 raise (Error ("Function " ^ name ^ " not found")) 69 70(* The following are not bound. Patches are welcome. 71target_machine : llexecutionengine -> Llvm_target.TargetMachine.t 72 *) 73