From: Peter Zotov Date: Fri, 31 Oct 2014 09:05:36 +0000 (+0000) Subject: [OCaml] Rework Llvm_executionengine using ctypes. X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=commitdiff_plain;h=ced3d172f8d83f50b4c8dec136f8123133bad36f;hp=130901ddf15ad290f8401efae1784919c1867fa1 [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 --- diff --git a/bindings/ocaml/Makefile.ocaml b/bindings/ocaml/Makefile.ocaml index e466b2b2a90..1bd14e9486f 100644 --- a/bindings/ocaml/Makefile.ocaml +++ b/bindings/ocaml/Makefile.ocaml @@ -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 %, \ diff --git a/bindings/ocaml/executionengine/Makefile b/bindings/ocaml/executionengine/Makefile index 6c2bd2a8d61..4059b6d805a 100644 --- a/bindings/ocaml/executionengine/Makefile +++ b/bindings/ocaml/executionengine/Makefile @@ -15,5 +15,6 @@ LEVEL := ../../.. LIBRARYNAME := llvm_executionengine UsedComponents := executionengine mcjit interpreter native UsedOcamlInterfaces := llvm llvm_target +FindlibPackages := ctypes include ../Makefile.ocaml diff --git a/bindings/ocaml/executionengine/executionengine_ocaml.c b/bindings/ocaml/executionengine/executionengine_ocaml.c index c647d23133c..0557efc5c9d 100644 --- a/bindings/ocaml/executionengine/executionengine_ocaml.c +++ b/bindings/ocaml/executionengine/executionengine_ocaml.c @@ -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)); - 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 (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)); +} diff --git a/bindings/ocaml/executionengine/llvm_executionengine.ml b/bindings/ocaml/executionengine/llvm_executionengine.ml index f61195337ca..c0ff3308dd0 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.ml +++ b/bindings/ocaml/executionengine/llvm_executionengine.ml @@ -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 - -module GenericValue = struct - type t - - 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 = { - opt_level: int; - code_model: CodeModel.t; - no_framepointer_elim: bool; - enable_fast_isel: bool; - } - - let default_compiler_options = { - opt_level = 0; - code_model = CodeModel.JIT_default; - no_framepointer_elim = false; - enable_fast_isel = false } - - external create: Llvm.llmodule -> t - = "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 - = "llvm_ee_dispose" - external add_module: Llvm.llmodule -> t -> unit - = "llvm_ee_add_module" - external remove_module: Llvm.llmodule -> t -> Llvm.llmodule - = "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 - = "llvm_ee_run_static_ctors" - external run_static_dtors: t -> 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 - = "llvm_ee_get_data_layout" - - (* The following are not bound. Patches are welcome. - - 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 - - *) -end - -external initialize_native_target : unit -> bool - = "llvm_initialize_native_target" +external initialize : unit -> bool + = "llvm_ee_initialize" + +type llexecutionengine + +type llcompileroptions = { + opt_level: int; + code_model: Llvm_target.CodeModel.t; + no_framepointer_elim: bool; + enable_fast_isel: bool; +} + +let default_compiler_options = { + opt_level = 0; + code_model = Llvm_target.CodeModel.JITDefault; + no_framepointer_elim = false; + enable_fast_isel = false } + +external create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine + = "llvm_ee_create" +external dispose : llexecutionengine -> unit + = "llvm_ee_dispose" +external add_module : Llvm.llmodule -> llexecutionengine -> unit + = "llvm_ee_add_module" +external remove_module : Llvm.llmodule -> llexecutionengine -> unit + = "llvm_ee_remove_module" +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" + +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)) + +(* The following are not bound. Patches are welcome. +target_machine : llexecutionengine -> Llvm_target.TargetMachine.t + *) diff --git a/bindings/ocaml/executionengine/llvm_executionengine.mli b/bindings/ocaml/executionengine/llvm_executionengine.mli index 772e2e574b8..b07151df744 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.mli +++ b/bindings/ocaml/executionengine/llvm_executionengine.mli @@ -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 - -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 - directly loading an LLVM module and executing its functions without first - invoking a static compiler and generating a native executable. *) - type t - - (** MCJIT compiler options. See [llvm::TargetOptions]. *) - type compileroptions = { - opt_level: int; - code_model: CodeModel.t; - no_framepointer_elim: bool; - enable_fast_isel: bool; - } - - (** 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 - - (** [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 - 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 - - (** [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 - - (** [dispose ee] releases the memory used by the execution engine and must be - invoked to avoid memory leaks. *) - val dispose : t -> unit - - (** [add_module m ee] adds the module [m] to the execution engine [ee]. *) - val add_module : Llvm.llmodule -> t -> 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 - - (** [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 - the execution engine [ee]. *) - val run_static_ctors : t -> unit - - (** [run_static_dtors ee] executes the static destructors of each module in - the execution engine [ee]. *) - val run_static_dtors : t -> 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 - - (** [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 - - (** [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 +(** [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 + +(** 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 llexecutionengine + +(** MCJIT compiler options. See [llvm::TargetOptions]. *) +type llcompileroptions = { + opt_level: int; + code_model: Llvm_target.CodeModel.t; + no_framepointer_elim: bool; + enable_fast_isel: bool; +} + +(** Default MCJIT compiler options: + [{ opt_level = 0; code_model = CodeModel.JIT_default; + no_framepointer_elim = false; enable_fast_isel = false }] *) +val default_compiler_options : llcompileroptions + +(** [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]. + + Run {!initialize} before using this function. + + See the function [llvm::EngineBuilder::create]. *) +val create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine + +(** [dispose ee] releases the memory used by the execution engine and must be + invoked to avoid memory leaks. *) +val dispose : llexecutionengine -> 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]. Raises [Error msg] if an error occurs. *) +val remove_module : Llvm.llmodule -> llexecutionengine -> unit + +(** [run_static_ctors ee] executes the static constructors of each module in + the execution engine [ee]. *) +val run_static_ctors : llexecutionengine -> unit + +(** [run_static_dtors ee] executes the static destructors of each module in + the execution engine [ee]. *) +val run_static_dtors : llexecutionengine -> unit + +(** [data_layout ee] is the data layout of the execution engine [ee]. *) +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 diff --git a/bindings/ocaml/llvm/META.llvm.in b/bindings/ocaml/llvm/META.llvm.in index c8eedb8f19f..6f224c51478 100644 --- a/bindings/ocaml/llvm/META.llvm.in +++ b/bindings/ocaml/llvm/META.llvm.in @@ -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" diff --git a/test/Bindings/Ocaml/executionengine.ml b/test/Bindings/Ocaml/executionengine.ml index 5ef56f63e73..9f1b74f8ee0 100644 --- a/test/Bindings/Ocaml/executionengine.ml +++ b/test/Bindings/Ocaml/executionengine.ml @@ -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); + (* create *) + let m = create_module (global_context ()) "test_module" in + let ee = create m in - let intgv = GenericValue.of_int i32_type 3 in - assert (3 = GenericValue.as_int intgv); + (* add plus *) + let plus = define_plus m in - let i32gv = GenericValue.of_int32 i32_type (Int32.of_int 4) in - assert ((Int32.of_int 4) = GenericValue.as_int32 i32gv); + (* add module *) + let m2 = create_module (global_context ()) "test_module2" in + add_module m2 ee; - let nigv = GenericValue.of_nativeint i32_type (Nativeint.of_int 5) in - assert ((Nativeint.of_int 5) = GenericValue.as_nativeint nigv); + (* 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; - let i64gv = GenericValue.of_int64 i64_type (Int64.of_int 6) in - assert ((Int64.of_int 6) = GenericValue.as_int64 i64gv) + (* 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"; -let test_executionengine engine = - (* create *) - let m = create_module (global_context ()) "test_module" in - let main = define_main_fn m 42 in + (* add getglobal *) + let getglobal = define_getglobal m2 g in*) - let m2 = create_module (global_context ()) "test_module2" in - define_plus m2; + (* run_static_ctors *) + run_static_ctors 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; + (* 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"; - (* run_static_ctors *) - ExecutionEngine.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"; - - (* 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 ()