[OCaml] Build a wrapper for LLVMGetFunctionAddress

[artagnon]

Summary

I've verified that the LLVMGetFunctionAddress is receiving the right
string, and calling down to the MCJIT implementation of
getFunctionAddress. However, getSymbolAddress does not seem to want to
cooperate with us, and returns 0 for a perfectly valid function. Why
LLVMGetFunctionAddress works via the C API, but not via the OCaml API
after having verified that the arguments are right stumps me.

Perhaps there is some name mangling going on when OCaml emits the IR? I
can't imagine why, but it's the only explanation I've been able to reach
so far.

[artagnon]

Note the limitations of gfa, fix tests.

[whitequark]

Can you please:

1. Add binding for LLVMGetGlobalValueAddress
2. Remove get_pointer_to_global entirely (it was never in a release and it's deprecated)

[artagnon]

Two suggestions by whitequark:

1. Remove gptg.
2. Expose gva as well.

[whitequark]

The wording in the documentation is a bit unclear.

I suggest:
Caution: this function finalizes, i.e. forces code generation, all loaded modules.
Further modifications to the modules will not have any effect.

[artagnon]

Use whitequark-suggested wording.

[whitequark]

Committed in rL224801

bindings/ocaml/executionengine/executionengine_ocaml.c

 
 /* Llvm.llvalue -> int64 -> llexecutionengine -> unit */
 CAMLprim value llvm_ee_add_global_mapping(LLVMValueRef Global, value Ptr,
                                           LLVMExecutionEngineRef EE) {
   LLVMAddGlobalMapping(EE, Global, (void*) (Int64_val(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)));
 }

bindings/ocaml/executionengine/llvm_executionengine.ml

 external run_static_ctors : llexecutionengine -> unit
   = "llvm_ee_run_static_ctors"
 external run_static_dtors : llexecutionengine -> unit
   = "llvm_ee_run_static_dtors"
 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
  *)

bindings/ocaml/executionengine/llvm_executionengine.mli

 val data_layout : llexecutionengine -> Llvm_target.DataLayout.t
 
 (** [add_global_mapping gv ptr ee] tells the execution engine [ee] that
     the global [gv] is at the specified location [ptr], which must outlive
     [gv] and [ee].
     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

test/Bindings/OCaml/executionengine.ml

 let test_executionengine () =
   let open Ctypes in
 
   (* create *)
   let m = create_module (global_context ()) "test_module" in
   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
   add_module m2 ee;
 
   (* add global mapping *)
   (* BROKEN: see PR20656 *)
   (* let g = declare_function "g" (function_type i32_type [||]) m2 in
   let cg = coerce (Foreign.funptr (void @-> returning int32_t)) (ptr void)
                                   (fun () -> 42l) in
   add_global_mapping g cg ee;
 
   (* check g *)
   let cg' = get_pointer_to_global g (ptr void) ee in
   if 0 <> ptr_compare cg cg' then bomb "int pointers to g differ";
 
   (* add getglobal *)
   let getglobal = define_getglobal m2 g in*)
 
   (* 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 *)
   (* let cgetglobalty = Foreign.funptr (void @-> returning int32_t) in
   let cgetglobal   = get_pointer_to_global getglobal cgetglobalty ee in
   if 42l <> cgetglobal () then bomb "getglobal didn't work"; *)
 
   (* remove_module *)