mirror of
https://github.com/c64scene-ar/llvm-6502.git
synced 2025-08-14 15:28:20 +00:00
[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
This commit is contained in:
@@ -115,8 +115,12 @@ CAMLprim value llvm_ee_add_global_mapping(LLVMValueRef Global, value Ptr,
|
|||||||
return Val_unit;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Llvm.llvalue -> llexecutionengine -> int64 */
|
CAMLprim value llvm_ee_get_global_value_address(value Name,
|
||||||
CAMLprim value llvm_ee_get_pointer_to_global(LLVMValueRef Global,
|
LLVMExecutionEngineRef EE) {
|
||||||
LLVMExecutionEngineRef EE) {
|
return caml_copy_int64((int64_t) LLVMGetGlobalValueAddress(EE, String_val(Name)));
|
||||||
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)));
|
||||||
}
|
}
|
||||||
|
@@ -45,15 +45,27 @@ external data_layout : llexecutionengine -> Llvm_target.DataLayout.t
|
|||||||
= "llvm_ee_get_data_layout"
|
= "llvm_ee_get_data_layout"
|
||||||
external add_global_mapping_ : Llvm.llvalue -> int64 -> llexecutionengine -> unit
|
external add_global_mapping_ : Llvm.llvalue -> int64 -> llexecutionengine -> unit
|
||||||
= "llvm_ee_add_global_mapping"
|
= "llvm_ee_add_global_mapping"
|
||||||
external get_pointer_to_global_ : Llvm.llvalue -> llexecutionengine -> int64
|
external get_global_value_address_ : string -> llexecutionengine -> int64
|
||||||
= "llvm_ee_get_pointer_to_global"
|
= "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 =
|
let add_global_mapping llval ptr ee =
|
||||||
add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee
|
add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee
|
||||||
|
|
||||||
let get_pointer_to_global llval typ ee =
|
let get_global_value_address name typ ee =
|
||||||
Ctypes.coerce (let open Ctypes in ptr void) typ
|
let vptr = get_global_value_address_ name ee in
|
||||||
(Ctypes.ptr_of_raw_address (get_pointer_to_global_ llval ee))
|
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.
|
(* The following are not bound. Patches are welcome.
|
||||||
target_machine : llexecutionengine -> Llvm_target.TargetMachine.t
|
target_machine : llexecutionengine -> Llvm_target.TargetMachine.t
|
||||||
|
@@ -76,9 +76,18 @@ val data_layout : llexecutionengine -> Llvm_target.DataLayout.t
|
|||||||
All uses of [gv] in the compiled code will refer to [ptr]. *)
|
All uses of [gv] in the compiled code will refer to [ptr]. *)
|
||||||
val add_global_mapping : Llvm.llvalue -> 'a Ctypes.ptr -> llexecutionengine -> unit
|
val add_global_mapping : Llvm.llvalue -> 'a Ctypes.ptr -> llexecutionengine -> unit
|
||||||
|
|
||||||
(** [get_pointer_to_global gv typ ee] returns the value of the global
|
(** [get_global_value_address id typ ee] returns a pointer to the
|
||||||
variable [gv] in the execution engine [ee] as type [typ], which may
|
identifier [id] as type [typ], which will be a pointer type for a
|
||||||
be a pointer type (e.g. [int ptr typ]) for global variables or
|
value, and which will be live as long as [id] and [ee]
|
||||||
a function (e.g. [(int -> int) typ]) type for functions, and which
|
are. Caution: this function finalizes, i.e. forces code
|
||||||
will be live as long as [gv] and [ee] are. *)
|
generation, all loaded modules. Further modifications to the
|
||||||
val get_pointer_to_global : Llvm.llvalue -> 'a Ctypes.typ -> llexecutionengine -> 'a
|
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
|
||||||
|
@@ -50,7 +50,10 @@ let test_executionengine () =
|
|||||||
let ee = create m in
|
let ee = create m in
|
||||||
|
|
||||||
(* add plus *)
|
(* 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 *)
|
(* add module *)
|
||||||
let m2 = create_module (global_context ()) "test_module2" in
|
let m2 = create_module (global_context ()) "test_module2" in
|
||||||
@@ -73,9 +76,13 @@ let test_executionengine () =
|
|||||||
(* run_static_ctors *)
|
(* run_static_ctors *)
|
||||||
run_static_ctors ee;
|
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 *)
|
(* call plus *)
|
||||||
let cplusty = Foreign.funptr (int32_t @-> int32_t @-> returning int32_t) in
|
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";
|
if 4l <> cplus 2l 2l then bomb "plus didn't work";
|
||||||
|
|
||||||
(* call getglobal *)
|
(* call getglobal *)
|
||||||
|
Reference in New Issue
Block a user