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-exception 6 * 7 *===----------------------------------------------------------------------===*) 8 9exception Error of string 10 11let () = Callback.register_exception "Llvm_executionengine.Error" (Error "") 12 13external initialize : unit -> bool 14 = "llvm_ee_initialize" 15 16type llexecutionengine 17 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 -> llexecutionengine 32 = "llvm_ee_create" 33external dispose : llexecutionengine -> unit 34 = "llvm_ee_dispose" 35external add_module : Llvm.llmodule -> llexecutionengine -> unit 36 = "llvm_ee_add_module" 37external remove_module : Llvm.llmodule -> llexecutionengine -> unit 38 = "llvm_ee_remove_module" 39external run_static_ctors : llexecutionengine -> unit 40 = "llvm_ee_run_static_ctors" 41external run_static_dtors : llexecutionengine -> unit 42 = "llvm_ee_run_static_dtors" 43external data_layout : llexecutionengine -> Llvm_target.DataLayout.t 44 = "llvm_ee_get_data_layout" 45external add_global_mapping_ : Llvm.llvalue -> nativeint -> llexecutionengine -> unit 46 = "llvm_ee_add_global_mapping" 47external get_global_value_address_ : string -> llexecutionengine -> nativeint 48 = "llvm_ee_get_global_value_address" 49external get_function_address_ : string -> llexecutionengine -> nativeint 50 = "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)) ee 54 55let get_global_value_address name typ ee = 56 let vptr = get_global_value_address_ name ee in 57 if Nativeint.to_int vptr <> 0 then 58 let open Ctypes in !@ (coerce (ptr void) (ptr typ) (ptr_of_raw_address vptr)) 59 else 60 raise (Error ("Value " ^ name ^ " not found")) 61 62let get_function_address name typ ee = 63 let fptr = get_function_address_ name ee in 64 if Nativeint.to_int fptr <> 0 then 65 let open Ctypes in coerce (ptr void) typ (ptr_of_raw_address fptr) 66 else 67 raise (Error ("Function " ^ name ^ " not found")) 68 69(* The following are not bound. Patches are welcome. 70target_machine : llexecutionengine -> Llvm_target.TargetMachine.t 71 *) 72