Expose the optimization level for the jit in ocaml.
[oota-llvm.git] / bindings / ocaml / executionengine / llvm_executionengine.ml
1 (*===-- llvm_executionengine.ml - LLVM Ocaml Interface ----------*- C++ -*-===*
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
11 exception Error of string
12
13 external register_exns: exn -> unit
14   = "llvm_register_ee_exns"
15
16
17 module GenericValue = struct
18   type t
19   
20   external of_float: Llvm.lltype -> float -> t
21     = "llvm_genericvalue_of_float"
22   external of_pointer: 'a -> t
23     = "llvm_genericvalue_of_value"
24   external of_int32: Llvm.lltype -> int32 -> t
25     = "llvm_genericvalue_of_int32"
26   external of_int: Llvm.lltype -> int -> t
27     = "llvm_genericvalue_of_int"
28   external of_nativeint: Llvm.lltype -> nativeint -> t
29     = "llvm_genericvalue_of_nativeint"
30   external of_int64: Llvm.lltype -> int64 -> t
31     = "llvm_genericvalue_of_int64"
32   
33   external as_float: Llvm.lltype -> t -> float
34     = "llvm_genericvalue_as_float"
35   external as_pointer: t -> 'a
36     = "llvm_genericvalue_as_value"
37   external as_int32: t -> int32
38     = "llvm_genericvalue_as_int32"
39   external as_int: t -> int
40     = "llvm_genericvalue_as_int"
41   external as_nativeint: t -> nativeint
42     = "llvm_genericvalue_as_nativeint"
43   external as_int64: t -> int64
44     = "llvm_genericvalue_as_int64"
45 end
46
47
48 module ExecutionEngine = struct
49   type t
50   
51   (* FIXME: Ocaml is not running this setup code unless we use 'val' in the
52             interface, which causes the emission of a stub for each function;
53             using 'external' in the module allows direct calls into 
54             ocaml_executionengine.c. This is hardly fatal, but it is unnecessary
55             overhead on top of the two stubs that are already invoked for each 
56             call into LLVM. *)
57   let _ = register_exns (Error "")
58   
59   external create: Llvm.llmodule -> t
60     = "llvm_ee_create"
61   external create_interpreter: Llvm.llmodule -> t
62     = "llvm_ee_create_interpreter"
63   external create_jit: Llvm.llmodule -> int -> t
64     = "llvm_ee_create_jit"
65   external dispose: t -> unit
66     = "llvm_ee_dispose"
67   external add_module: Llvm.llmodule -> t -> unit
68     = "llvm_ee_add_mp"
69   external remove_module: Llvm.llmodule -> t -> Llvm.llmodule
70     = "llvm_ee_remove_mp"
71   external find_function: string -> t -> Llvm.llvalue option
72     = "llvm_ee_find_function"
73   external run_function: Llvm.llvalue -> GenericValue.t array -> t ->
74                          GenericValue.t
75     = "llvm_ee_run_function"
76   external run_static_ctors: t -> unit
77     = "llvm_ee_run_static_ctors"
78   external run_static_dtors: t -> unit
79     = "llvm_ee_run_static_dtors"
80   external run_function_as_main: Llvm.llvalue -> string array ->
81                                  (string * string) array -> t -> int
82     = "llvm_ee_run_function_as_main"
83   external free_machine_code: Llvm.llvalue -> t -> unit
84     = "llvm_ee_free_machine_code"
85
86   external target_data: t -> Llvm_target.TargetData.t
87     = "LLVMGetExecutionEngineTargetData"
88   
89   (* The following are not bound. Patches are welcome.
90   
91   get_target_data: t -> lltargetdata
92   add_global_mapping: llvalue -> llgenericvalue -> t -> unit
93   clear_all_global_mappings: t -> unit
94   update_global_mapping: llvalue -> llgenericvalue -> t -> unit
95   get_pointer_to_global_if_available: llvalue -> t -> llgenericvalue
96   get_pointer_to_global: llvalue -> t -> llgenericvalue
97   get_pointer_to_function: llvalue -> t -> llgenericvalue
98   get_pointer_to_function_or_stub: llvalue -> t -> llgenericvalue
99   get_global_value_at_address: llgenericvalue -> t -> llvalue option
100   store_value_to_memory: llgenericvalue -> llgenericvalue -> lltype -> unit
101   initialize_memory: llvalue -> llgenericvalue -> t -> unit
102   recompile_and_relink_function: llvalue -> t -> llgenericvalue
103   get_or_emit_global_variable: llvalue -> t -> llgenericvalue
104   disable_lazy_compilation: t -> unit
105   lazy_compilation_enabled: t -> bool
106   install_lazy_function_creator: (string -> llgenericvalue) -> t -> unit
107   
108    *)
109 end
110
111 external initialize_native_target : unit -> bool
112                                   = "llvm_initialize_native_target"