[PATCH] [OCaml] Build a wrapper for LLVMGetFunctionAddress

[Ramkumar Ramachandra]

Note the limitations of gfa, fix tests.


http://reviews.llvm.org/D6761

Files:
  bindings/ocaml/executionengine/executionengine_ocaml.c
  bindings/ocaml/executionengine/llvm_executionengine.ml
  bindings/ocaml/executionengine/llvm_executionengine.mli
  test/Bindings/OCaml/executionengine.ml

Index: bindings/ocaml/executionengine/executionengine_ocaml.c
===================================================================
--- bindings/ocaml/executionengine/executionengine_ocaml.c
+++ bindings/ocaml/executionengine/executionengine_ocaml.c
@@ -120,3 +120,8 @@
                                              LLVMExecutionEngineRef EE) {
   return caml_copy_int64((int64_t) LLVMGetPointerToGlobal(EE, Global));
 }
+
+CAMLprim value llvm_ee_get_function_address(value Name,
+					    LLVMExecutionEngineRef EE) {
+  return caml_copy_int64((int64_t) LLVMGetFunctionAddress(EE, String_val(Name)));
+}
Index: bindings/ocaml/executionengine/llvm_executionengine.ml
===================================================================
--- bindings/ocaml/executionengine/llvm_executionengine.ml
+++ bindings/ocaml/executionengine/llvm_executionengine.ml
@@ -47,14 +47,23 @@
   = "llvm_ee_add_global_mapping"
 external get_pointer_to_global_ : Llvm.llvalue -> llexecutionengine -> int64
   = "llvm_ee_get_pointer_to_global"
+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_function_address name typ ee =
+  let ptr = get_function_address_ name ee in
+  if Int64.to_int ptr <> 0 then
+    Ctypes.coerce (let open Ctypes in ptr void) typ (Ctypes.ptr_of_raw_address ptr)
+  else
+    raise (Error ("Function " ^ name ^ " not found"))
+
 (* The following are not bound. Patches are welcome.
 target_machine : llexecutionengine -> Llvm_target.TargetMachine.t
  *)
Index: bindings/ocaml/executionengine/llvm_executionengine.mli
===================================================================
--- bindings/ocaml/executionengine/llvm_executionengine.mli
+++ bindings/ocaml/executionengine/llvm_executionengine.mli
@@ -82,3 +82,12 @@
     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_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 loaded modules;
+    calls to this function must be batched up and executed all-at-once
+    at the end, after which no further items may be added to the
+    module. *)
+val get_function_address : string -> 'a Ctypes.typ -> llexecutionengine -> 'a
Index: test/Bindings/OCaml/executionengine.ml
===================================================================
--- test/Bindings/OCaml/executionengine.ml
+++ test/Bindings/OCaml/executionengine.ml
@@ -50,7 +50,7 @@
   let ee = create m in
 
   (* add plus *)
-  let plus = define_plus m in
+  ignore (define_plus m);
 
   (* add module *)
   let m2 = create_module (global_context ()) "test_module2" in
@@ -75,7 +75,7 @@
 
   (* 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 *)

EMAIL PREFERENCES
  http://reviews.llvm.org/settings/panel/emailpreferences/
-------------- next part --------------
A non-text attachment was scrubbed...
Name: D6761.17612.patch
Type: text/x-patch
Size: 3536 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20141224/a1c530af/attachment.bin>