From: Peter Zotov Date: Wed, 24 Dec 2014 01:52:51 +0000 (+0000) Subject: [OCaml] Expose Llvm_executionengine.get_{global_value,function}_address. X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=commitdiff_plain;h=0357f8735ed3f102248961dbc5fa48f2f21e395e [OCaml] Expose Llvm_executionengine.get_{global_value,function}_address. Patch by Ramkumar Ramachandra . Also remove Llvm_executionengine.get_pointer_to_global, as it is actually deprecated and didn't appear in a stable release. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@224801 91177308-0d34-0410-b5e6-96231b3b80d8 --- diff --git a/bindings/ocaml/executionengine/executionengine_ocaml.c b/bindings/ocaml/executionengine/executionengine_ocaml.c index 0557efc5c9d..b7992508bf9 100644 --- a/bindings/ocaml/executionengine/executionengine_ocaml.c +++ b/bindings/ocaml/executionengine/executionengine_ocaml.c @@ -115,8 +115,12 @@ CAMLprim value llvm_ee_add_global_mapping(LLVMValueRef Global, value Ptr, return Val_unit; } -/* Llvm.llvalue -> llexecutionengine -> int64 */ -CAMLprim value llvm_ee_get_pointer_to_global(LLVMValueRef Global, - LLVMExecutionEngineRef EE) { - return caml_copy_int64((int64_t) LLVMGetPointerToGlobal(EE, Global)); +CAMLprim value llvm_ee_get_global_value_address(value Name, + LLVMExecutionEngineRef EE) { + return caml_copy_int64((int64_t) LLVMGetGlobalValueAddress(EE, String_val(Name))); +} + +CAMLprim value llvm_ee_get_function_address(value Name, + LLVMExecutionEngineRef EE) { + return caml_copy_int64((int64_t) LLVMGetFunctionAddress(EE, String_val(Name))); } diff --git a/bindings/ocaml/executionengine/llvm_executionengine.ml b/bindings/ocaml/executionengine/llvm_executionengine.ml index c0ff3308dd0..34031bed603 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.ml +++ b/bindings/ocaml/executionengine/llvm_executionengine.ml @@ -45,15 +45,27 @@ external data_layout : llexecutionengine -> Llvm_target.DataLayout.t = "llvm_ee_get_data_layout" external add_global_mapping_ : Llvm.llvalue -> int64 -> llexecutionengine -> unit = "llvm_ee_add_global_mapping" -external get_pointer_to_global_ : Llvm.llvalue -> llexecutionengine -> int64 - = "llvm_ee_get_pointer_to_global" +external get_global_value_address_ : string -> llexecutionengine -> int64 + = "llvm_ee_get_global_value_address" +external get_function_address_ : string -> llexecutionengine -> int64 + = "llvm_ee_get_function_address" let add_global_mapping llval ptr ee = add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee -let get_pointer_to_global llval typ ee = - Ctypes.coerce (let open Ctypes in ptr void) typ - (Ctypes.ptr_of_raw_address (get_pointer_to_global_ llval ee)) +let get_global_value_address name typ ee = + let vptr = get_global_value_address_ name ee in + if Int64.to_int vptr <> 0 then + let open Ctypes in !@ (coerce (ptr void) (ptr typ) (ptr_of_raw_address vptr)) + else + raise (Error ("Value " ^ name ^ " not found")) + +let get_function_address name typ ee = + let fptr = get_function_address_ name ee in + if Int64.to_int fptr <> 0 then + let open Ctypes in coerce (ptr void) typ (ptr_of_raw_address fptr) + else + raise (Error ("Function " ^ name ^ " not found")) (* The following are not bound. Patches are welcome. target_machine : llexecutionengine -> Llvm_target.TargetMachine.t diff --git a/bindings/ocaml/executionengine/llvm_executionengine.mli b/bindings/ocaml/executionengine/llvm_executionengine.mli index b07151df744..bc076beacea 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.mli +++ b/bindings/ocaml/executionengine/llvm_executionengine.mli @@ -76,9 +76,18 @@ val data_layout : llexecutionengine -> Llvm_target.DataLayout.t All uses of [gv] in the compiled code will refer to [ptr]. *) val add_global_mapping : Llvm.llvalue -> 'a Ctypes.ptr -> llexecutionengine -> unit -(** [get_pointer_to_global gv typ ee] returns the value of the global - variable [gv] in the execution engine [ee] as type [typ], which may - be a pointer type (e.g. [int ptr typ]) for global variables or - a function (e.g. [(int -> int) typ]) type for functions, and which - will be live as long as [gv] and [ee] are. *) -val get_pointer_to_global : Llvm.llvalue -> 'a Ctypes.typ -> llexecutionengine -> 'a +(** [get_global_value_address id typ ee] returns a pointer to the + identifier [id] as type [typ], which will be a pointer type for a + value, and which will be live as long as [id] and [ee] + are. Caution: this function finalizes, i.e. forces code + generation, all loaded modules. Further modifications to the + modules will not have any effect. *) +val get_global_value_address : string -> 'a Ctypes.typ -> llexecutionengine -> 'a + +(** [get_function_address fn typ ee] returns a pointer to the function + [fn] as type [typ], which will be a pointer type for a function + (e.g. [(int -> int) typ]), and which will be live as long as [fn] + and [ee] are. Caution: this function finalizes, i.e. forces code + generation, all loaded modules. Further modifications to the + modules will not have any effect. *) +val get_function_address : string -> 'a Ctypes.typ -> llexecutionengine -> 'a diff --git a/test/Bindings/OCaml/executionengine.ml b/test/Bindings/OCaml/executionengine.ml index 893f9888764..1de2cfb7fef 100644 --- a/test/Bindings/OCaml/executionengine.ml +++ b/test/Bindings/OCaml/executionengine.ml @@ -50,7 +50,10 @@ let test_executionengine () = let ee = create m in (* add plus *) - let plus = define_plus m in + ignore (define_plus m); + + (* declare global variable *) + ignore (define_global "globvar" (const_int i32_type 23) m); (* add module *) let m2 = create_module (global_context ()) "test_module2" in @@ -73,9 +76,13 @@ let test_executionengine () = (* run_static_ctors *) run_static_ctors ee; + (* get a handle on globvar *) + let varh = get_global_value_address "globvar" int32_t ee in + if 23l <> varh then bomb "get_global_value_address didn't work"; + (* call plus *) let cplusty = Foreign.funptr (int32_t @-> int32_t @-> returning int32_t) in - let cplus = get_pointer_to_global plus cplusty ee in + let cplus = get_function_address "plus" cplusty ee in if 4l <> cplus 2l 2l then bomb "plus didn't work"; (* call getglobal *)