mirror of
https://github.com/c64scene-ar/llvm-6502.git
synced 2024-12-26 21:32:10 +00:00
[OCaml] Rework Llvm_executionengine using ctypes.
Since JIT->MCJIT migration, most of the ExecutionEngine interface became deprecated and/or broken. This especially affected the OCaml bindings, as runFunction is no longer available, and unlike in C, it is not possible to coerce a pointer to a function and call it in OCaml. In practice, LLVM 3.5 shipped completely unusable Llvm_executionengine. The GenericValue interface and runFunction were essentially a poor man's FFI. As such, this interface was removed and instead a dependency on ctypes >=0.3 added, which handled platform-specific aspects of accessing data and calling functions. The new interface does not expose JIT (which is a shim around MCJIT), as well as the interpreter (which can't handle a lot of valid IR). Llvm_executionengine.add_global_mapping is currently unusable due to PR20656. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@220957 91177308-0d34-0410-b5e6-96231b3b80d8
This commit is contained in:
Peter Zotov
parent
130901ddf1
commit
ced3d172f8
@ -55,7 +55,8 @@ endif
|
||||
endif
|
||||
|
||||
# Tools
|
||||
OCAMLCFLAGS += -I $(OcamlDir)
|
||||
OCAMLCFLAGS += -I $(OcamlDir) $(addprefix -package ,$(FindlibPackages))
|
||||
|
||||
ifndef IS_CLEANING_TARGET
|
||||
ifneq ($(ObjectsO),)
|
||||
OCAMLAFLAGS += $(patsubst %,-cclib %, \
|
||||
|
||||
@ -15,5 +15,6 @@ LEVEL := ../../..
|
||||
LIBRARYNAME := llvm_executionengine
|
||||
UsedComponents := executionengine mcjit interpreter native
|
||||
UsedOcamlInterfaces := llvm llvm_target
|
||||
FindlibPackages := ctypes
|
||||
|
||||
include ../Makefile.ocaml
|
||||
|
||||
@ -27,118 +27,8 @@
|
||||
|
||||
void llvm_raise(value Prototype, char *Message);
|
||||
|
||||
/*--... Operations on generic values .......................................--*/
|
||||
|
||||
#define Genericvalue_val(v) (*(LLVMGenericValueRef *)(Data_custom_val(v)))
|
||||
|
||||
static void llvm_finalize_generic_value(value GenVal) {
|
||||
LLVMDisposeGenericValue(Genericvalue_val(GenVal));
|
||||
}
|
||||
|
||||
static struct custom_operations generic_value_ops = {
|
||||
(char *) "Llvm_executionengine.GenericValue.t",
|
||||
llvm_finalize_generic_value,
|
||||
custom_compare_default,
|
||||
custom_hash_default,
|
||||
custom_serialize_default,
|
||||
custom_deserialize_default,
|
||||
custom_compare_ext_default
|
||||
};
|
||||
|
||||
static value alloc_generic_value(LLVMGenericValueRef Ref) {
|
||||
value Val = alloc_custom(&generic_value_ops, sizeof(LLVMGenericValueRef), 0, 1);
|
||||
Genericvalue_val(Val) = Ref;
|
||||
return Val;
|
||||
}
|
||||
|
||||
/* Llvm.lltype -> float -> t */
|
||||
CAMLprim value llvm_genericvalue_of_float(LLVMTypeRef Ty, value N) {
|
||||
CAMLparam1(N);
|
||||
CAMLreturn(alloc_generic_value(
|
||||
LLVMCreateGenericValueOfFloat(Ty, Double_val(N))));
|
||||
}
|
||||
|
||||
/* 'a -> t */
|
||||
CAMLprim value llvm_genericvalue_of_pointer(value V) {
|
||||
CAMLparam1(V);
|
||||
CAMLreturn(alloc_generic_value(LLVMCreateGenericValueOfPointer(Op_val(V))));
|
||||
}
|
||||
|
||||
/* Llvm.lltype -> int -> t */
|
||||
CAMLprim value llvm_genericvalue_of_int(LLVMTypeRef Ty, value Int) {
|
||||
return alloc_generic_value(LLVMCreateGenericValueOfInt(Ty, Int_val(Int), 1));
|
||||
}
|
||||
|
||||
/* Llvm.lltype -> int32 -> t */
|
||||
CAMLprim value llvm_genericvalue_of_int32(LLVMTypeRef Ty, value Int32) {
|
||||
CAMLparam1(Int32);
|
||||
CAMLreturn(alloc_generic_value(
|
||||
LLVMCreateGenericValueOfInt(Ty, Int32_val(Int32), 1)));
|
||||
}
|
||||
|
||||
/* Llvm.lltype -> nativeint -> t */
|
||||
CAMLprim value llvm_genericvalue_of_nativeint(LLVMTypeRef Ty, value NatInt) {
|
||||
CAMLparam1(NatInt);
|
||||
CAMLreturn(alloc_generic_value(
|
||||
LLVMCreateGenericValueOfInt(Ty, Nativeint_val(NatInt), 1)));
|
||||
}
|
||||
|
||||
/* Llvm.lltype -> int64 -> t */
|
||||
CAMLprim value llvm_genericvalue_of_int64(LLVMTypeRef Ty, value Int64) {
|
||||
CAMLparam1(Int64);
|
||||
CAMLreturn(alloc_generic_value(
|
||||
LLVMCreateGenericValueOfInt(Ty, Int64_val(Int64), 1)));
|
||||
}
|
||||
|
||||
/* Llvm.lltype -> t -> float */
|
||||
CAMLprim value llvm_genericvalue_as_float(LLVMTypeRef Ty, value GenVal) {
|
||||
CAMLparam1(GenVal);
|
||||
CAMLreturn(copy_double(
|
||||
LLVMGenericValueToFloat(Ty, Genericvalue_val(GenVal))));
|
||||
}
|
||||
|
||||
/* t -> 'a */
|
||||
CAMLprim value llvm_genericvalue_as_pointer(value GenVal) {
|
||||
return Val_op(LLVMGenericValueToPointer(Genericvalue_val(GenVal)));
|
||||
}
|
||||
|
||||
/* t -> int */
|
||||
CAMLprim value llvm_genericvalue_as_int(value GenVal) {
|
||||
assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 8 * sizeof(value)
|
||||
&& "Generic value too wide to treat as an int!");
|
||||
return Val_int(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1));
|
||||
}
|
||||
|
||||
/* t -> int32 */
|
||||
CAMLprim value llvm_genericvalue_as_int32(value GenVal) {
|
||||
CAMLparam1(GenVal);
|
||||
assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 32
|
||||
&& "Generic value too wide to treat as an int32!");
|
||||
CAMLreturn(copy_int32(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)));
|
||||
}
|
||||
|
||||
/* t -> int64 */
|
||||
CAMLprim value llvm_genericvalue_as_int64(value GenVal) {
|
||||
CAMLparam1(GenVal);
|
||||
assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 64
|
||||
&& "Generic value too wide to treat as an int64!");
|
||||
CAMLreturn(copy_int64(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)));
|
||||
}
|
||||
|
||||
/* t -> nativeint */
|
||||
CAMLprim value llvm_genericvalue_as_nativeint(value GenVal) {
|
||||
CAMLparam1(GenVal);
|
||||
assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 8 * sizeof(value)
|
||||
&& "Generic value too wide to treat as a nativeint!");
|
||||
CAMLreturn(copy_nativeint(LLVMGenericValueToInt(Genericvalue_val(GenVal),1)));
|
||||
}
|
||||
|
||||
|
||||
/*--... Operations on execution engines ....................................--*/
|
||||
|
||||
/* unit -> bool */
|
||||
CAMLprim value llvm_initialize_native_target(value Unit) {
|
||||
LLVMLinkInInterpreter();
|
||||
CAMLprim value llvm_ee_initialize(value Unit) {
|
||||
LLVMLinkInMCJIT();
|
||||
|
||||
return Val_bool(!LLVMInitializeNativeTarget() &&
|
||||
@ -146,48 +36,22 @@ CAMLprim value llvm_initialize_native_target(value Unit) {
|
||||
!LLVMInitializeNativeAsmPrinter());
|
||||
}
|
||||
|
||||
/* llmodule -> ExecutionEngine.t */
|
||||
CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleRef M) {
|
||||
LLVMExecutionEngineRef Interp;
|
||||
char *Error;
|
||||
if (LLVMCreateExecutionEngineForModule(&Interp, M, &Error))
|
||||
llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
|
||||
return Interp;
|
||||
}
|
||||
|
||||
/* llmodule -> ExecutionEngine.t */
|
||||
CAMLprim LLVMExecutionEngineRef
|
||||
llvm_ee_create_interpreter(LLVMModuleRef M) {
|
||||
LLVMExecutionEngineRef Interp;
|
||||
char *Error;
|
||||
if (LLVMCreateInterpreterForModule(&Interp, M, &Error))
|
||||
llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
|
||||
return Interp;
|
||||
}
|
||||
|
||||
/* llmodule -> int -> ExecutionEngine.t */
|
||||
CAMLprim LLVMExecutionEngineRef
|
||||
llvm_ee_create_jit(LLVMModuleRef M, value OptLevel) {
|
||||
LLVMExecutionEngineRef JIT;
|
||||
char *Error;
|
||||
if (LLVMCreateJITCompilerForModule(&JIT, M, Int_val(OptLevel), &Error))
|
||||
llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
|
||||
return JIT;
|
||||
}
|
||||
|
||||
/* llmodule -> llcompileroption -> ExecutionEngine.t */
|
||||
CAMLprim LLVMExecutionEngineRef
|
||||
llvm_ee_create_mcjit(LLVMModuleRef M, value OptRecord) {
|
||||
CAMLprim LLVMExecutionEngineRef llvm_ee_create(value OptRecordOpt, LLVMModuleRef M) {
|
||||
value OptRecord;
|
||||
LLVMExecutionEngineRef MCJIT;
|
||||
char *Error;
|
||||
struct LLVMMCJITCompilerOptions Options;
|
||||
|
||||
LLVMInitializeMCJITCompilerOptions(&Options, sizeof(Options));
|
||||
if (OptRecordOpt != Val_int(0)) {
|
||||
OptRecord = Field(OptRecordOpt, 0);
|
||||
Options.OptLevel = Int_val(Field(OptRecord, 0));
|
||||
Options.CodeModel = Int_val(Field(OptRecord, 1));
|
||||
Options.NoFramePointerElim = Int_val(Field(OptRecord, 2));
|
||||
Options.EnableFastISel = Int_val(Field(OptRecord, 3));
|
||||
Options.MCJMM = NULL;
|
||||
}
|
||||
|
||||
if (LLVMCreateMCJITCompilerForModule(&MCJIT, M, &Options,
|
||||
sizeof(Options), &Error))
|
||||
@ -208,43 +72,12 @@ CAMLprim value llvm_ee_add_module(LLVMModuleRef M, LLVMExecutionEngineRef EE) {
|
||||
}
|
||||
|
||||
/* llmodule -> ExecutionEngine.t -> llmodule */
|
||||
CAMLprim LLVMModuleRef llvm_ee_remove_module(LLVMModuleRef M,
|
||||
LLVMExecutionEngineRef EE) {
|
||||
CAMLprim value llvm_ee_remove_module(LLVMModuleRef M, LLVMExecutionEngineRef EE) {
|
||||
LLVMModuleRef RemovedModule;
|
||||
char *Error;
|
||||
if (LLVMRemoveModule(EE, M, &RemovedModule, &Error))
|
||||
llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
|
||||
return RemovedModule;
|
||||
}
|
||||
|
||||
/* string -> ExecutionEngine.t -> llvalue option */
|
||||
CAMLprim value llvm_ee_find_function(value Name, LLVMExecutionEngineRef EE) {
|
||||
CAMLparam1(Name);
|
||||
CAMLlocal1(Option);
|
||||
LLVMValueRef Found;
|
||||
if (LLVMFindFunction(EE, String_val(Name), &Found))
|
||||
CAMLreturn(Val_unit);
|
||||
Option = alloc(1, 0);
|
||||
Field(Option, 0) = Val_op(Found);
|
||||
CAMLreturn(Option);
|
||||
}
|
||||
|
||||
/* llvalue -> GenericValue.t array -> ExecutionEngine.t -> GenericValue.t */
|
||||
CAMLprim value llvm_ee_run_function(LLVMValueRef F, value Args,
|
||||
LLVMExecutionEngineRef EE) {
|
||||
unsigned NumArgs;
|
||||
LLVMGenericValueRef Result, *GVArgs;
|
||||
unsigned I;
|
||||
|
||||
NumArgs = Wosize_val(Args);
|
||||
GVArgs = (LLVMGenericValueRef*) malloc(NumArgs * sizeof(LLVMGenericValueRef));
|
||||
for (I = 0; I != NumArgs; ++I)
|
||||
GVArgs[I] = Genericvalue_val(Field(Args, I));
|
||||
|
||||
Result = LLVMRunFunction(EE, F, NumArgs, GVArgs);
|
||||
|
||||
free(GVArgs);
|
||||
return alloc_generic_value(Result);
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
/* ExecutionEngine.t -> unit */
|
||||
@ -259,66 +92,6 @@ CAMLprim value llvm_ee_run_static_dtors(LLVMExecutionEngineRef EE) {
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
/* llvalue -> string array -> (string * string) array -> ExecutionEngine.t ->
|
||||
int */
|
||||
CAMLprim value llvm_ee_run_function_as_main(LLVMValueRef F,
|
||||
value Args, value Env,
|
||||
LLVMExecutionEngineRef EE) {
|
||||
CAMLparam2(Args, Env);
|
||||
int I, NumArgs, NumEnv, EnvSize, Result;
|
||||
const char **CArgs, **CEnv;
|
||||
char *CEnvBuf, *Pos;
|
||||
|
||||
NumArgs = Wosize_val(Args);
|
||||
NumEnv = Wosize_val(Env);
|
||||
|
||||
/* Build the environment. */
|
||||
CArgs = (const char **) malloc(NumArgs * sizeof(char*));
|
||||
for (I = 0; I != NumArgs; ++I)
|
||||
CArgs[I] = String_val(Field(Args, I));
|
||||
|
||||
/* Compute the size of the environment string buffer. */
|
||||
for (I = 0, EnvSize = 0; I != NumEnv; ++I) {
|
||||
EnvSize += strlen(String_val(Field(Field(Env, I), 0))) + 1;
|
||||
EnvSize += strlen(String_val(Field(Field(Env, I), 1))) + 1;
|
||||
}
|
||||
|
||||
/* Build the environment. */
|
||||
CEnv = (const char **) malloc((NumEnv + 1) * sizeof(char*));
|
||||
CEnvBuf = (char*) malloc(EnvSize);
|
||||
Pos = CEnvBuf;
|
||||
for (I = 0; I != NumEnv; ++I) {
|
||||
char *Name = String_val(Field(Field(Env, I), 0)),
|
||||
*Value = String_val(Field(Field(Env, I), 1));
|
||||
int NameLen = strlen(Name),
|
||||
ValueLen = strlen(Value);
|
||||
|
||||
CEnv[I] = Pos;
|
||||
memcpy(Pos, Name, NameLen);
|
||||
Pos += NameLen;
|
||||
*Pos++ = '=';
|
||||
memcpy(Pos, Value, ValueLen);
|
||||
Pos += ValueLen;
|
||||
*Pos++ = '\0';
|
||||
}
|
||||
CEnv[NumEnv] = NULL;
|
||||
|
||||
Result = LLVMRunFunctionAsMain(EE, F, NumArgs, CArgs, CEnv);
|
||||
|
||||
free(CArgs);
|
||||
free(CEnv);
|
||||
free(CEnvBuf);
|
||||
|
||||
CAMLreturn(Val_int(Result));
|
||||
}
|
||||
|
||||
/* llvalue -> ExecutionEngine.t -> unit */
|
||||
CAMLprim value llvm_ee_free_machine_code(LLVMValueRef F,
|
||||
LLVMExecutionEngineRef EE) {
|
||||
LLVMFreeMachineCodeForFunction(EE, F);
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
extern value llvm_alloc_data_layout(LLVMTargetDataRef TargetData);
|
||||
|
||||
/* ExecutionEngine.t -> Llvm_target.DataLayout.t */
|
||||
@ -334,3 +107,16 @@ CAMLprim value llvm_ee_get_data_layout(LLVMExecutionEngineRef EE) {
|
||||
|
||||
return DataLayout;
|
||||
}
|
||||
|
||||
/* 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));
|
||||
}
|
||||
|
||||
@ -11,115 +11,50 @@ exception Error of string
|
||||
|
||||
let () = Callback.register_exception "Llvm_executionengine.Error" (Error "")
|
||||
|
||||
module CodeModel = struct
|
||||
type t =
|
||||
| Default
|
||||
| JIT_default
|
||||
| Small
|
||||
| Kernel
|
||||
| Medium
|
||||
| Large
|
||||
end
|
||||
external initialize : unit -> bool
|
||||
= "llvm_ee_initialize"
|
||||
|
||||
module GenericValue = struct
|
||||
type t
|
||||
type llexecutionengine
|
||||
|
||||
external of_float: Llvm.lltype -> float -> t
|
||||
= "llvm_genericvalue_of_float"
|
||||
external of_pointer: 'a -> t
|
||||
= "llvm_genericvalue_of_pointer"
|
||||
external of_int32: Llvm.lltype -> int32 -> t
|
||||
= "llvm_genericvalue_of_int32"
|
||||
external of_int: Llvm.lltype -> int -> t
|
||||
= "llvm_genericvalue_of_int"
|
||||
external of_nativeint: Llvm.lltype -> nativeint -> t
|
||||
= "llvm_genericvalue_of_nativeint"
|
||||
external of_int64: Llvm.lltype -> int64 -> t
|
||||
= "llvm_genericvalue_of_int64"
|
||||
|
||||
external as_float: Llvm.lltype -> t -> float
|
||||
= "llvm_genericvalue_as_float"
|
||||
external as_pointer: t -> 'a
|
||||
= "llvm_genericvalue_as_pointer"
|
||||
external as_int32: t -> int32
|
||||
= "llvm_genericvalue_as_int32"
|
||||
external as_int: t -> int
|
||||
= "llvm_genericvalue_as_int"
|
||||
external as_nativeint: t -> nativeint
|
||||
= "llvm_genericvalue_as_nativeint"
|
||||
external as_int64: t -> int64
|
||||
= "llvm_genericvalue_as_int64"
|
||||
end
|
||||
|
||||
|
||||
module ExecutionEngine = struct
|
||||
type t
|
||||
|
||||
type compileroptions = {
|
||||
type llcompileroptions = {
|
||||
opt_level: int;
|
||||
code_model: CodeModel.t;
|
||||
code_model: Llvm_target.CodeModel.t;
|
||||
no_framepointer_elim: bool;
|
||||
enable_fast_isel: bool;
|
||||
}
|
||||
}
|
||||
|
||||
let default_compiler_options = {
|
||||
let default_compiler_options = {
|
||||
opt_level = 0;
|
||||
code_model = CodeModel.JIT_default;
|
||||
code_model = Llvm_target.CodeModel.JITDefault;
|
||||
no_framepointer_elim = false;
|
||||
enable_fast_isel = false }
|
||||
|
||||
external create: Llvm.llmodule -> t
|
||||
external create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine
|
||||
= "llvm_ee_create"
|
||||
external create_interpreter: Llvm.llmodule -> t
|
||||
= "llvm_ee_create_interpreter"
|
||||
external create_jit: Llvm.llmodule -> int -> t
|
||||
= "llvm_ee_create_jit"
|
||||
external create_mcjit: Llvm.llmodule -> compileroptions -> t
|
||||
= "llvm_ee_create_mcjit"
|
||||
external dispose: t -> unit
|
||||
external dispose : llexecutionengine -> unit
|
||||
= "llvm_ee_dispose"
|
||||
external add_module: Llvm.llmodule -> t -> unit
|
||||
external add_module : Llvm.llmodule -> llexecutionengine -> unit
|
||||
= "llvm_ee_add_module"
|
||||
external remove_module: Llvm.llmodule -> t -> Llvm.llmodule
|
||||
external remove_module : Llvm.llmodule -> llexecutionengine -> unit
|
||||
= "llvm_ee_remove_module"
|
||||
external find_function: string -> t -> Llvm.llvalue option
|
||||
= "llvm_ee_find_function"
|
||||
external run_function: Llvm.llvalue -> GenericValue.t array -> t ->
|
||||
GenericValue.t
|
||||
= "llvm_ee_run_function"
|
||||
external run_static_ctors: t -> unit
|
||||
external run_static_ctors : llexecutionengine -> unit
|
||||
= "llvm_ee_run_static_ctors"
|
||||
external run_static_dtors: t -> unit
|
||||
external run_static_dtors : llexecutionengine -> unit
|
||||
= "llvm_ee_run_static_dtors"
|
||||
external run_function_as_main: Llvm.llvalue -> string array ->
|
||||
(string * string) array -> t -> int
|
||||
= "llvm_ee_run_function_as_main"
|
||||
external free_machine_code: Llvm.llvalue -> t -> unit
|
||||
= "llvm_ee_free_machine_code"
|
||||
|
||||
external data_layout : t -> Llvm_target.DataLayout.t
|
||||
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"
|
||||
|
||||
(* The following are not bound. Patches are welcome.
|
||||
let add_global_mapping llval ptr ee =
|
||||
add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee
|
||||
|
||||
add_global_mapping: llvalue -> llgenericvalue -> t -> unit
|
||||
clear_all_global_mappings: t -> unit
|
||||
update_global_mapping: llvalue -> llgenericvalue -> t -> unit
|
||||
get_pointer_to_global_if_available: llvalue -> t -> llgenericvalue
|
||||
get_pointer_to_global: llvalue -> t -> llgenericvalue
|
||||
get_pointer_to_function: llvalue -> t -> llgenericvalue
|
||||
get_pointer_to_function_or_stub: llvalue -> t -> llgenericvalue
|
||||
get_global_value_at_address: llgenericvalue -> t -> llvalue option
|
||||
store_value_to_memory: llgenericvalue -> llgenericvalue -> lltype -> unit
|
||||
initialize_memory: llvalue -> llgenericvalue -> t -> unit
|
||||
recompile_and_relink_function: llvalue -> t -> llgenericvalue
|
||||
get_or_emit_global_variable: llvalue -> t -> llgenericvalue
|
||||
disable_lazy_compilation: t -> unit
|
||||
lazy_compilation_enabled: t -> bool
|
||||
install_lazy_function_creator: (string -> llgenericvalue) -> t -> unit
|
||||
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))
|
||||
|
||||
(* The following are not bound. Patches are welcome.
|
||||
target_machine : llexecutionengine -> Llvm_target.TargetMachine.t
|
||||
*)
|
||||
end
|
||||
|
||||
external initialize_native_target : unit -> bool
|
||||
= "llvm_initialize_native_target"
|
||||
|
||||
@ -14,176 +14,71 @@
|
||||
|
||||
exception Error of string
|
||||
|
||||
(** The JIT code model. See [llvm::CodeModel::Model]. *)
|
||||
module CodeModel : sig
|
||||
type t =
|
||||
| Default
|
||||
| JIT_default
|
||||
| Small
|
||||
| Kernel
|
||||
| Medium
|
||||
| Large
|
||||
end
|
||||
(** [initialize ()] initializes the backend corresponding to the host.
|
||||
Returns [true] if initialization is successful; [false] indicates
|
||||
that there is no such backend or it is unable to emit object code
|
||||
via MCJIT. *)
|
||||
val initialize : unit -> bool
|
||||
|
||||
module GenericValue: sig
|
||||
(** [GenericValue.t] is a boxed union type used to portably pass arguments to
|
||||
and receive values from the execution engine. It supports only a limited
|
||||
selection of types; for more complex argument types, it is necessary to
|
||||
generate a stub function by hand or to pass parameters by reference.
|
||||
See the struct [llvm::GenericValue]. *)
|
||||
type t
|
||||
|
||||
(** [of_float fpty n] boxes the float [n] in a float-valued generic value
|
||||
according to the floating point type [fpty]. See the fields
|
||||
[llvm::GenericValue::DoubleVal] and [llvm::GenericValue::FloatVal]. *)
|
||||
val of_float : Llvm.lltype -> float -> t
|
||||
|
||||
(** [of_pointer v] boxes the pointer value [v] in a generic value. See the
|
||||
field [llvm::GenericValue::PointerVal]. *)
|
||||
val of_pointer : 'a -> t
|
||||
|
||||
(** [of_int32 n w] boxes the int32 [i] in a generic value with the bitwidth
|
||||
[w]. See the field [llvm::GenericValue::IntVal]. *)
|
||||
val of_int32 : Llvm.lltype -> int32 -> t
|
||||
|
||||
(** [of_int n w] boxes the int [i] in a generic value with the bitwidth
|
||||
[w]. See the field [llvm::GenericValue::IntVal]. *)
|
||||
val of_int : Llvm.lltype -> int -> t
|
||||
|
||||
(** [of_natint n w] boxes the native int [i] in a generic value with the
|
||||
bitwidth [w]. See the field [llvm::GenericValue::IntVal]. *)
|
||||
val of_nativeint : Llvm.lltype -> nativeint -> t
|
||||
|
||||
(** [of_int64 n w] boxes the int64 [i] in a generic value with the bitwidth
|
||||
[w]. See the field [llvm::GenericValue::IntVal]. *)
|
||||
val of_int64 : Llvm.lltype -> int64 -> t
|
||||
|
||||
(** [as_float fpty gv] unboxes the floating point-valued generic value [gv] of
|
||||
floating point type [fpty]. See the fields [llvm::GenericValue::DoubleVal]
|
||||
and [llvm::GenericValue::FloatVal]. *)
|
||||
val as_float : Llvm.lltype -> t -> float
|
||||
|
||||
(** [as_pointer gv] unboxes the pointer-valued generic value [gv]. See the
|
||||
field [llvm::GenericValue::PointerVal]. *)
|
||||
val as_pointer : t -> 'a
|
||||
|
||||
(** [as_int32 gv] unboxes the integer-valued generic value [gv] as an [int32].
|
||||
Is invalid if [gv] has a bitwidth greater than 32 bits. See the field
|
||||
[llvm::GenericValue::IntVal]. *)
|
||||
val as_int32 : t -> int32
|
||||
|
||||
(** [as_int gv] unboxes the integer-valued generic value [gv] as an [int].
|
||||
Is invalid if [gv] has a bitwidth greater than the host bit width (but the
|
||||
most significant bit may be lost). See the field
|
||||
[llvm::GenericValue::IntVal]. *)
|
||||
val as_int : t -> int
|
||||
|
||||
(** [as_natint gv] unboxes the integer-valued generic value [gv] as a
|
||||
[nativeint]. Is invalid if [gv] has a bitwidth greater than
|
||||
[nativeint]. See the field [llvm::GenericValue::IntVal]. *)
|
||||
val as_nativeint : t -> nativeint
|
||||
|
||||
(** [as_int64 gv] returns the integer-valued generic value [gv] as an [int64].
|
||||
Is invalid if [gv] has a bitwidth greater than [int64]. See the field
|
||||
[llvm::GenericValue::IntVal]. *)
|
||||
val as_int64 : t -> int64
|
||||
end
|
||||
|
||||
|
||||
module ExecutionEngine: sig
|
||||
(** An execution engine is either a JIT compiler or an interpreter, capable of
|
||||
(** An execution engine is either a JIT compiler or an interpreter, capable of
|
||||
directly loading an LLVM module and executing its functions without first
|
||||
invoking a static compiler and generating a native executable. *)
|
||||
type t
|
||||
type llexecutionengine
|
||||
|
||||
(** MCJIT compiler options. See [llvm::TargetOptions]. *)
|
||||
type compileroptions = {
|
||||
(** MCJIT compiler options. See [llvm::TargetOptions]. *)
|
||||
type llcompileroptions = {
|
||||
opt_level: int;
|
||||
code_model: CodeModel.t;
|
||||
code_model: Llvm_target.CodeModel.t;
|
||||
no_framepointer_elim: bool;
|
||||
enable_fast_isel: bool;
|
||||
}
|
||||
}
|
||||
|
||||
(** Default MCJIT compiler options:
|
||||
(** Default MCJIT compiler options:
|
||||
[{ opt_level = 0; code_model = CodeModel.JIT_default;
|
||||
no_framepointer_elim = false; enable_fast_isel = false }] *)
|
||||
val default_compiler_options : compileroptions
|
||||
val default_compiler_options : llcompileroptions
|
||||
|
||||
(** [create m] creates a new execution engine, taking ownership of the
|
||||
module [m] if successful. Creates a JIT if possible, else falls back to an
|
||||
interpreter. Raises [Error msg] if an error occurrs. The execution engine
|
||||
is not garbage collected and must be destroyed with [dispose ee].
|
||||
See the function [llvm::EngineBuilder::create]. *)
|
||||
val create : Llvm.llmodule -> t
|
||||
|
||||
(** [create_interpreter m] creates a new interpreter, taking ownership of the
|
||||
module [m] if successful. Raises [Error msg] if an error occurrs. The
|
||||
execution engine is not garbage collected and must be destroyed with
|
||||
[dispose ee].
|
||||
See the function [llvm::EngineBuilder::create]. *)
|
||||
val create_interpreter : Llvm.llmodule -> t
|
||||
|
||||
(** [create_jit m optlevel] creates a new JIT (just-in-time compiler), taking
|
||||
(** [create m optlevel] creates a new MCJIT just-in-time compiler, taking
|
||||
ownership of the module [m] if successful with the desired optimization
|
||||
level [optlevel]. Raises [Error msg] if an error occurrs. The execution
|
||||
engine is not garbage collected and must be destroyed with [dispose ee].
|
||||
See the function [llvm::EngineBuilder::create].
|
||||
|
||||
Deprecated; use {!create_mcjit}. This function is a shim for {!create_mcjit}. *)
|
||||
val create_jit : Llvm.llmodule -> int -> t
|
||||
Run {!initialize} before using this function.
|
||||
|
||||
(** [create_jit m optlevel] creates a new JIT (just-in-time compiler), taking
|
||||
ownership of the module [m] if successful with the desired optimization
|
||||
level [optlevel]. Raises [Error msg] if an error occurrs. The execution
|
||||
engine is not garbage collected and must be destroyed with [dispose ee].
|
||||
See the function [llvm::EngineBuilder::create]. *)
|
||||
val create_mcjit : Llvm.llmodule -> compileroptions -> t
|
||||
val create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine
|
||||
|
||||
(** [dispose ee] releases the memory used by the execution engine and must be
|
||||
(** [dispose ee] releases the memory used by the execution engine and must be
|
||||
invoked to avoid memory leaks. *)
|
||||
val dispose : t -> unit
|
||||
val dispose : llexecutionengine -> unit
|
||||
|
||||
(** [add_module m ee] adds the module [m] to the execution engine [ee]. *)
|
||||
val add_module : Llvm.llmodule -> t -> unit
|
||||
(** [add_module m ee] adds the module [m] to the execution engine [ee]. *)
|
||||
val add_module : Llvm.llmodule -> llexecutionengine -> unit
|
||||
|
||||
(** [remove_module m ee] removes the module [m] from the execution engine
|
||||
[ee], disposing of [m] and the module referenced by [mp]. Raises
|
||||
[Error msg] if an error occurs. *)
|
||||
val remove_module : Llvm.llmodule -> t -> Llvm.llmodule
|
||||
(** [remove_module m ee] removes the module [m] from the execution engine
|
||||
[ee]. Raises [Error msg] if an error occurs. *)
|
||||
val remove_module : Llvm.llmodule -> llexecutionengine -> unit
|
||||
|
||||
(** [find_function n ee] finds the function named [n] defined in any of the
|
||||
modules owned by the execution engine [ee]. Returns [None] if the function
|
||||
is not found and [Some f] otherwise. *)
|
||||
val find_function : string -> t -> Llvm.llvalue option
|
||||
|
||||
(** [run_function f args ee] synchronously executes the function [f] with the
|
||||
arguments [args], which must be compatible with the parameter types. *)
|
||||
val run_function : Llvm.llvalue -> GenericValue.t array -> t ->
|
||||
GenericValue.t
|
||||
|
||||
(** [run_static_ctors ee] executes the static constructors of each module in
|
||||
(** [run_static_ctors ee] executes the static constructors of each module in
|
||||
the execution engine [ee]. *)
|
||||
val run_static_ctors : t -> unit
|
||||
val run_static_ctors : llexecutionengine -> unit
|
||||
|
||||
(** [run_static_dtors ee] executes the static destructors of each module in
|
||||
(** [run_static_dtors ee] executes the static destructors of each module in
|
||||
the execution engine [ee]. *)
|
||||
val run_static_dtors : t -> unit
|
||||
val run_static_dtors : llexecutionengine -> unit
|
||||
|
||||
(** [run_function_as_main f args env ee] executes the function [f] as a main
|
||||
function, passing it [argv] and [argc] according to the string array
|
||||
[args], and [envp] as specified by the array [env]. Returns the integer
|
||||
return value of the function. *)
|
||||
val run_function_as_main : Llvm.llvalue -> string array ->
|
||||
(string * string) array -> t -> int
|
||||
(** [data_layout ee] is the data layout of the execution engine [ee]. *)
|
||||
val data_layout : llexecutionengine -> Llvm_target.DataLayout.t
|
||||
|
||||
(** [free_machine_code f ee] releases the memory in the execution engine [ee]
|
||||
used to store the machine code for the function [f]. *)
|
||||
val free_machine_code : Llvm.llvalue -> t -> unit
|
||||
(** [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
|
||||
|
||||
(** [data_layout ee] is the data layout of the execution engine [ee]. *)
|
||||
val data_layout : t -> Llvm_target.DataLayout.t
|
||||
end
|
||||
|
||||
(** [initialize_native_target ()] initializes the native target corresponding
|
||||
to the host. Returns [true] if initialization is {b not} done. *)
|
||||
val initialize_native_target : unit -> bool
|
||||
(** [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
|
||||
|
||||
@ -31,7 +31,7 @@ package "bitwriter" (
|
||||
)
|
||||
|
||||
package "executionengine" (
|
||||
requires = "llvm,llvm.target"
|
||||
requires = "llvm,llvm.target,ctypes.foreign"
|
||||
version = "@PACKAGE_VERSION@"
|
||||
description = "JIT and Interpreter for LLVM"
|
||||
archive(byte) = "llvm_executionengine.cma"
|
||||
|
||||
@ -19,20 +19,17 @@ let i64_type = Llvm.i64_type context
|
||||
let double_type = Llvm.double_type context
|
||||
|
||||
let () =
|
||||
assert (Llvm_executionengine.initialize_native_target ())
|
||||
assert (Llvm_executionengine.initialize ())
|
||||
|
||||
let bomb msg =
|
||||
prerr_endline msg;
|
||||
exit 2
|
||||
|
||||
let define_main_fn m retval =
|
||||
let fn =
|
||||
let str_arr_type = pointer_type (pointer_type i8_type) in
|
||||
define_function "main" (function_type i32_type [| i32_type;
|
||||
str_arr_type;
|
||||
str_arr_type |]) m in
|
||||
let define_getglobal m pg =
|
||||
let fn = define_function "getglobal" (function_type i32_type [||]) m in
|
||||
let b = builder_at_end (global_context ()) (entry_block fn) in
|
||||
ignore (build_ret (const_int i32_type retval) b);
|
||||
let g = build_call pg [||] "" b in
|
||||
ignore (build_ret g b);
|
||||
fn
|
||||
|
||||
let define_plus m =
|
||||
@ -40,94 +37,67 @@ let define_plus m =
|
||||
i32_type |]) m in
|
||||
let b = builder_at_end (global_context ()) (entry_block fn) in
|
||||
let add = build_add (param fn 0) (param fn 1) "sum" b in
|
||||
ignore (build_ret add b)
|
||||
ignore (build_ret add b);
|
||||
fn
|
||||
|
||||
let test_genericvalue () =
|
||||
let tu = (1, 2) in
|
||||
let ptrgv = GenericValue.of_pointer tu in
|
||||
assert (tu = GenericValue.as_pointer ptrgv);
|
||||
let test_executionengine () =
|
||||
let open Ctypes in
|
||||
|
||||
let fpgv = GenericValue.of_float double_type 2. in
|
||||
assert (2. = GenericValue.as_float double_type fpgv);
|
||||
|
||||
let intgv = GenericValue.of_int i32_type 3 in
|
||||
assert (3 = GenericValue.as_int intgv);
|
||||
|
||||
let i32gv = GenericValue.of_int32 i32_type (Int32.of_int 4) in
|
||||
assert ((Int32.of_int 4) = GenericValue.as_int32 i32gv);
|
||||
|
||||
let nigv = GenericValue.of_nativeint i32_type (Nativeint.of_int 5) in
|
||||
assert ((Nativeint.of_int 5) = GenericValue.as_nativeint nigv);
|
||||
|
||||
let i64gv = GenericValue.of_int64 i64_type (Int64.of_int 6) in
|
||||
assert ((Int64.of_int 6) = GenericValue.as_int64 i64gv)
|
||||
|
||||
let test_executionengine engine =
|
||||
(* create *)
|
||||
let m = create_module (global_context ()) "test_module" in
|
||||
let main = define_main_fn m 42 in
|
||||
let ee = create m in
|
||||
|
||||
(* add plus *)
|
||||
let plus = define_plus m in
|
||||
|
||||
(* add module *)
|
||||
let m2 = create_module (global_context ()) "test_module2" in
|
||||
define_plus m2;
|
||||
add_module m2 ee;
|
||||
|
||||
let ee =
|
||||
match engine with
|
||||
| `Interpreter -> ExecutionEngine.create_interpreter m
|
||||
| `JIT -> ExecutionEngine.create_jit m 0
|
||||
| `MCJIT -> ExecutionEngine.create_mcjit m ExecutionEngine.default_compiler_options
|
||||
in
|
||||
ExecutionEngine.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 *)
|
||||
ExecutionEngine.run_static_ctors ee;
|
||||
run_static_ctors ee;
|
||||
|
||||
(* run_function_as_main *)
|
||||
let res = ExecutionEngine.run_function_as_main main [|"test"|] [||] ee in
|
||||
if 42 != res then bomb "main did not return 42";
|
||||
(* call plus *)
|
||||
let cplusty = Foreign.funptr (int32_t @-> int32_t @-> returning int32_t) in
|
||||
let cplus = get_pointer_to_global plus cplusty ee in
|
||||
if 4l <> cplus 2l 2l then bomb "plus didn't work";
|
||||
|
||||
(* free_machine_code *)
|
||||
ExecutionEngine.free_machine_code main ee;
|
||||
|
||||
(* find_function *)
|
||||
match ExecutionEngine.find_function "dne" ee with
|
||||
| Some _ -> raise (Failure "find_function 'dne' failed")
|
||||
| None ->
|
||||
|
||||
match ExecutionEngine.find_function "plus" ee with
|
||||
| None -> raise (Failure "find_function 'plus' failed")
|
||||
| Some plus ->
|
||||
|
||||
begin match engine with
|
||||
| `MCJIT -> () (* Currently can only invoke 0-ary functions *)
|
||||
| `JIT -> () (* JIT is now a shim around MCJIT, jokes on you *)
|
||||
| _ ->
|
||||
(* run_function *)
|
||||
let res = ExecutionEngine.run_function plus
|
||||
[| GenericValue.of_int i32_type 2;
|
||||
GenericValue.of_int i32_type 2 |]
|
||||
ee in
|
||||
if 4 != GenericValue.as_int res then bomb "plus did not work";
|
||||
end;
|
||||
(* 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 *)
|
||||
Llvm.dispose_module (ExecutionEngine.remove_module m2 ee);
|
||||
remove_module m2 ee;
|
||||
dispose_module m2;
|
||||
|
||||
(* run_static_dtors *)
|
||||
ExecutionEngine.run_static_dtors ee;
|
||||
run_static_dtors ee;
|
||||
|
||||
(* Show that the data layout binding links and runs.*)
|
||||
let dl = ExecutionEngine.data_layout ee in
|
||||
let dl = data_layout ee in
|
||||
|
||||
(* Demonstrate that a garbage pointer wasn't returned. *)
|
||||
let ty = DataLayout.intptr_type context dl in
|
||||
if ty != i32_type && ty != i64_type then bomb "target_data did not work";
|
||||
|
||||
(* dispose *)
|
||||
ExecutionEngine.dispose ee
|
||||
dispose ee
|
||||
|
||||
let () =
|
||||
test_genericvalue ();
|
||||
test_executionengine `Interpreter;
|
||||
test_executionengine `JIT;
|
||||
test_executionengine `MCJIT;
|
||||
()
|
||||
test_executionengine ();
|
||||
Gc.compact ()
|
||||
|
||||
Loading…
Reference in New Issue
Block a user