[OCaml] Expose Llvm_executionengine.get_{global_value,function}_address.
[oota-llvm.git] / bindings / ocaml / executionengine / llvm_executionengine.ml
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
10 exception Error of string
11
12 let () = Callback.register_exception "Llvm_executionengine.Error" (Error "")
13
14 external initialize : unit -> bool
15   = "llvm_ee_initialize"
16
17 type llexecutionengine
18
19 type llcompileroptions = {
20   opt_level: int;
21   code_model: Llvm_target.CodeModel.t;
22   no_framepointer_elim: bool;
23   enable_fast_isel: bool;
24 }
25
26 let 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
32 external create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine
33   = "llvm_ee_create"
34 external dispose : llexecutionengine -> unit
35   = "llvm_ee_dispose"
36 external add_module : Llvm.llmodule -> llexecutionengine -> unit
37   = "llvm_ee_add_module"
38 external remove_module : Llvm.llmodule -> llexecutionengine -> unit
39   = "llvm_ee_remove_module"
40 external run_static_ctors : llexecutionengine -> unit
41   = "llvm_ee_run_static_ctors"
42 external run_static_dtors : llexecutionengine -> unit
43   = "llvm_ee_run_static_dtors"
44 external data_layout : llexecutionengine -> Llvm_target.DataLayout.t
45   = "llvm_ee_get_data_layout"
46 external add_global_mapping_ : Llvm.llvalue -> int64 -> llexecutionengine -> unit
47   = "llvm_ee_add_global_mapping"
48 external get_global_value_address_ : string -> llexecutionengine -> int64
49   = "llvm_ee_get_global_value_address"
50 external get_function_address_ : string -> llexecutionengine -> int64
51   = "llvm_ee_get_function_address"
52
53 let add_global_mapping llval ptr ee =
54   add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee
55
56 let get_global_value_address name typ ee =
57   let vptr = get_global_value_address_ name ee in
58   if Int64.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
63 let get_function_address name typ ee =
64   let fptr = get_function_address_ name ee in
65   if Int64.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.
71 target_machine : llexecutionengine -> Llvm_target.TargetMachine.t
72  *)