72 lines · plain
1(*===-- llvm_executionengine.ml - LLVM OCaml Interface --------*- OCaml -*-===*2 *3 * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4 * See https://llvm.org/LICENSE.txt for license information.5 * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6 *7 *===----------------------------------------------------------------------===*)8 9exception Error of string10 11let () = Callback.register_exception "Llvm_executionengine.Error" (Error "")12 13external initialize : unit -> bool14 = "llvm_ee_initialize"15 16type llexecutionengine17 18type llcompileroptions = {19 opt_level: int;20 code_model: Llvm_target.CodeModel.t;21 no_framepointer_elim: bool;22 enable_fast_isel: bool;23}24 25let default_compiler_options = {26 opt_level = 0;27 code_model = Llvm_target.CodeModel.JITDefault;28 no_framepointer_elim = false;29 enable_fast_isel = false }30 31external create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine32 = "llvm_ee_create"33external dispose : llexecutionengine -> unit34 = "llvm_ee_dispose"35external add_module : Llvm.llmodule -> llexecutionengine -> unit36 = "llvm_ee_add_module"37external remove_module : Llvm.llmodule -> llexecutionengine -> unit38 = "llvm_ee_remove_module"39external run_static_ctors : llexecutionengine -> unit40 = "llvm_ee_run_static_ctors"41external run_static_dtors : llexecutionengine -> unit42 = "llvm_ee_run_static_dtors"43external data_layout : llexecutionengine -> Llvm_target.DataLayout.t44 = "llvm_ee_get_data_layout"45external add_global_mapping_ : Llvm.llvalue -> nativeint -> llexecutionengine -> unit46 = "llvm_ee_add_global_mapping"47external get_global_value_address_ : string -> llexecutionengine -> nativeint48 = "llvm_ee_get_global_value_address"49external get_function_address_ : string -> llexecutionengine -> nativeint50 = "llvm_ee_get_function_address"51 52let add_global_mapping llval ptr ee =53 add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee54 55let get_global_value_address name typ ee =56 let vptr = get_global_value_address_ name ee in57 if Nativeint.to_int vptr <> 0 then58 let open Ctypes in !@ (coerce (ptr void) (ptr typ) (ptr_of_raw_address vptr))59 else60 raise (Error ("Value " ^ name ^ " not found"))61 62let get_function_address name typ ee =63 let fptr = get_function_address_ name ee in64 if Nativeint.to_int fptr <> 0 then65 let open Ctypes in coerce (ptr void) typ (ptr_of_raw_address fptr)66 else67 raise (Error ("Function " ^ name ^ " not found"))68 69(* The following are not bound. Patches are welcome.70target_machine : llexecutionengine -> Llvm_target.TargetMachine.t71 *)72