llvm.org GIT mirror llvm / 0357f87
[OCaml] Expose Llvm_executionengine.get_{global_value,function}_address. Patch by Ramkumar Ramachandra <artagnon@gmail.com>. 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 Peter Zotov 5 years ago
4 changed file(s) with 49 addition(s) and 17 deletion(s). Raw diff Collapse all Expand all
114114 return Val_unit;
115115 }
116116
117 /* Llvm.llvalue -> llexecutionengine -> int64 */
118 CAMLprim value llvm_ee_get_pointer_to_global(LLVMValueRef Global,
119 LLVMExecutionEngineRef EE) {
120 return caml_copy_int64((int64_t) LLVMGetPointerToGlobal(EE, Global));
117 CAMLprim value llvm_ee_get_global_value_address(value Name,
118 LLVMExecutionEngineRef EE) {
119 return caml_copy_int64((int64_t) LLVMGetGlobalValueAddress(EE, String_val(Name)));
121120 }
121
122 CAMLprim value llvm_ee_get_function_address(value Name,
123 LLVMExecutionEngineRef EE) {
124 return caml_copy_int64((int64_t) LLVMGetFunctionAddress(EE, String_val(Name)));
125 }
4444 = "llvm_ee_get_data_layout"
4545 external add_global_mapping_ : Llvm.llvalue -> int64 -> llexecutionengine -> unit
4646 = "llvm_ee_add_global_mapping"
47 external get_pointer_to_global_ : Llvm.llvalue -> llexecutionengine -> int64
48 = "llvm_ee_get_pointer_to_global"
47 external get_global_value_address_ : string -> llexecutionengine -> int64
48 = "llvm_ee_get_global_value_address"
49 external get_function_address_ : string -> llexecutionengine -> int64
50 = "llvm_ee_get_function_address"
4951
5052 let add_global_mapping llval ptr ee =
5153 add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee
5254
53 let get_pointer_to_global llval typ ee =
54 Ctypes.coerce (let open Ctypes in ptr void) typ
55 (Ctypes.ptr_of_raw_address (get_pointer_to_global_ llval ee))
55 let get_global_value_address name typ ee =
56 let vptr = get_global_value_address_ name ee in
57 if Int64.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
62 let get_function_address name typ ee =
63 let fptr = get_function_address_ name ee in
64 if Int64.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"))
5668
5769 (* The following are not bound. Patches are welcome.
5870 target_machine : llexecutionengine -> Llvm_target.TargetMachine.t
7575 All uses of [gv] in the compiled code will refer to [ptr]. *)
7676 val add_global_mapping : Llvm.llvalue -> 'a Ctypes.ptr -> llexecutionengine -> unit
7777
78 (** [get_pointer_to_global gv typ ee] returns the value of the global
79 variable [gv] in the execution engine [ee] as type [typ], which may
80 be a pointer type (e.g. [int ptr typ]) for global variables or
81 a function (e.g. [(int -> int) typ]) type for functions, and which
82 will be live as long as [gv] and [ee] are. *)
83 val get_pointer_to_global : Llvm.llvalue -> 'a Ctypes.typ -> llexecutionengine -> 'a
78 (** [get_global_value_address id typ ee] returns a pointer to the
79 identifier [id] as type [typ], which will be a pointer type for a
80 value, and which will be live as long as [id] and [ee]
81 are. Caution: this function finalizes, i.e. forces code
82 generation, all loaded modules. Further modifications to the
83 modules will not have any effect. *)
84 val get_global_value_address : string -> 'a Ctypes.typ -> llexecutionengine -> 'a
85
86 (** [get_function_address fn typ ee] returns a pointer to the function
87 [fn] as type [typ], which will be a pointer type for a function
88 (e.g. [(int -> int) typ]), and which will be live as long as [fn]
89 and [ee] are. Caution: this function finalizes, i.e. forces code
90 generation, all loaded modules. Further modifications to the
91 modules will not have any effect. *)
92 val get_function_address : string -> 'a Ctypes.typ -> llexecutionengine -> 'a
4949 let ee = create m in
5050
5151 (* add plus *)
52 let plus = define_plus m in
52 ignore (define_plus m);
53
54 (* declare global variable *)
55 ignore (define_global "globvar" (const_int i32_type 23) m);
5356
5457 (* add module *)
5558 let m2 = create_module (global_context ()) "test_module2" in
7275 (* run_static_ctors *)
7376 run_static_ctors ee;
7477
78 (* get a handle on globvar *)
79 let varh = get_global_value_address "globvar" int32_t ee in
80 if 23l <> varh then bomb "get_global_value_address didn't work";
81
7582 (* call plus *)
7683 let cplusty = Foreign.funptr (int32_t @-> int32_t @-> returning int32_t) in
77 let cplus = get_pointer_to_global plus cplusty ee in
84 let cplus = get_function_address "plus" cplusty ee in
7885 if 4l <> cplus 2l 2l then bomb "plus didn't work";
7986
8087 (* call getglobal *)