From 2e855e68d861224c9b61e2bc9cecad1536b1534b Mon Sep 17 00:00:00 2001 From: Gordon Henriksen Date: Sun, 23 Dec 2007 16:59:28 +0000 Subject: [PATCH] C and Ocaml bindings for ExecutionEngine (i.e., the JIT compiler). git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@45335 91177308-0d34-0410-b5e6-96231b3b80d8 --- Xcode/LLVM.xcodeproj/project.pbxproj | 20 ++ bindings/ocaml/Makefile | 2 +- bindings/ocaml/Makefile.ocaml | 18 +- bindings/ocaml/bitreader/bitreader_ocaml.c | 15 +- bindings/ocaml/executionengine/Makefile | 20 ++ .../executionengine/executionengine_ocaml.c | 301 ++++++++++++++++++ .../executionengine/llvm_executionengine.ml | 106 ++++++ .../executionengine/llvm_executionengine.mli | 152 +++++++++ bindings/ocaml/llvm/llvm_ocaml.c | 6 +- include/llvm-c/ExecutionEngine.h | 115 +++++++ .../ExecutionEngineBindings.cpp | 187 +++++++++++ test/Bindings/Ocaml/executionengine.ml | 101 ++++++ 12 files changed, 1031 insertions(+), 12 deletions(-) create mode 100644 bindings/ocaml/executionengine/Makefile create mode 100644 bindings/ocaml/executionengine/executionengine_ocaml.c create mode 100644 bindings/ocaml/executionengine/llvm_executionengine.ml create mode 100644 bindings/ocaml/executionengine/llvm_executionengine.mli create mode 100644 include/llvm-c/ExecutionEngine.h create mode 100644 lib/ExecutionEngine/ExecutionEngineBindings.cpp create mode 100644 test/Bindings/Ocaml/executionengine.ml diff --git a/Xcode/LLVM.xcodeproj/project.pbxproj b/Xcode/LLVM.xcodeproj/project.pbxproj index 8c7762e0cc9..416ba597c7a 100644 --- a/Xcode/LLVM.xcodeproj/project.pbxproj +++ b/Xcode/LLVM.xcodeproj/project.pbxproj @@ -85,6 +85,11 @@ 9F4B0E600D0E02580061F270 /* llvm_bitreader.mli */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = llvm_bitreader.mli; sourceTree = ""; }; 9F4B0E8C0D0E05ED0061F270 /* BitReader.cpp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.cpp.cpp; path = BitReader.cpp; sourceTree = ""; }; 9F4B0E8D0D0E05ED0061F270 /* DeserializeAPFloat.cpp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.cpp.cpp; path = DeserializeAPFloat.cpp; sourceTree = ""; }; + 9F502ADB0D1D8CA3007939DF /* executionengine_ocaml.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = executionengine_ocaml.c; sourceTree = ""; }; + 9F502ADC0D1D8CA3007939DF /* llvm_executionengine.ml */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = llvm_executionengine.ml; sourceTree = ""; }; + 9F502ADD0D1D8CA3007939DF /* llvm_executionengine.mli */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = llvm_executionengine.mli; sourceTree = ""; }; + 9F502AEC0D1D8CF8007939DF /* executionengine.ml */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = executionengine.ml; sourceTree = ""; }; + 9F502B090D1D8D8D007939DF /* ExecutionEngineBindings.cpp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.cpp.cpp; path = ExecutionEngineBindings.cpp; sourceTree = ""; }; 9F5B90CB0D0CE87100CDFDEA /* StringPool.cpp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.cpp.cpp; path = StringPool.cpp; sourceTree = ""; }; 9F5B90CE0D0CE89300CDFDEA /* AlignOf.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = AlignOf.h; sourceTree = ""; }; 9F5B90CF0D0CE89300CDFDEA /* Registry.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = Registry.h; sourceTree = ""; }; @@ -233,6 +238,7 @@ 9FE450E00C77ABE400C4FEA4 /* ArchiveInternals.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ArchiveInternals.h; sourceTree = ""; }; 9FE450E10C77ABE400C4FEA4 /* ArchiveReader.cpp */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.cpp.cpp; path = ArchiveReader.cpp; sourceTree = ""; }; 9FE450E20C77ABE400C4FEA4 /* ArchiveWriter.cpp */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.cpp.cpp; path = ArchiveWriter.cpp; sourceTree = ""; }; + 9FEB8C550D1CD1E200EE46BC /* ExecutionEngine.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = ExecutionEngine.h; sourceTree = ""; }; CF1ACC9709C9DE4400D3C5EB /* IntrinsicInst.cpp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.cpp.cpp; name = IntrinsicInst.cpp; path = ../lib/VMCore/IntrinsicInst.cpp; sourceTree = ""; }; CF26835B09178F5500C5F253 /* TargetInstrItineraries.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = TargetInstrItineraries.h; sourceTree = ""; }; CF32AF5C0AEE6A4E00D24CD4 /* LLVMTargetMachine.cpp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.cpp.cpp; path = LLVMTargetMachine.cpp; sourceTree = ""; }; @@ -1121,6 +1127,16 @@ path = bitreader; sourceTree = ""; }; + 9F502ACD0D1D8CA3007939DF /* executionengine */ = { + isa = PBXGroup; + children = ( + 9F502ADB0D1D8CA3007939DF /* executionengine_ocaml.c */, + 9F502ADC0D1D8CA3007939DF /* llvm_executionengine.ml */, + 9F502ADD0D1D8CA3007939DF /* llvm_executionengine.mli */, + ); + path = executionengine; + sourceTree = ""; + }; 9F68EB030C77AD2C004AA152 /* lib/Bitcode */ = { isa = PBXGroup; children = ( @@ -1244,6 +1260,7 @@ 9F7C2C4F0CB9496C00498408 /* analysis.ml */, 9F6B2CC00D0F6E56000F00FD /* bitreader.ml */, 9F7C2C520CB9496C00498408 /* bitwriter.ml */, + 9F502AEC0D1D8CF8007939DF /* executionengine.ml */, 9F7C2C5D0CB9496C00498408 /* vmcore.ml */, ); path = Ocaml; @@ -1269,6 +1286,7 @@ 9FD3E56F0CA0116100E54D15 /* ocaml */ = { isa = PBXGroup; children = ( + 9F502ACD0D1D8CA3007939DF /* executionengine */, 9F7C240B0CB81ECD00498408 /* analysis */, 9F4B0E5D0D0E02580061F270 /* bitreader */, 9FD3E5700CA0116100E54D15 /* bitwriter */, @@ -1316,6 +1334,7 @@ 9F5B90E70D0DF19100CDFDEA /* BitReader.h */, 9FD3E58D0CA0125F00E54D15 /* BitWriter.h */, 9FD3E58E0CA0125F00E54D15 /* Core.h */, + 9FEB8C550D1CD1E200EE46BC /* ExecutionEngine.h */, CF8F1B490B64F7AB00BB4199 /* LinkTimeOptimizer.h */, ); name = "include/llvm-c"; @@ -1607,6 +1626,7 @@ DE66EDC508ABEC9000323D32 /* Interpreter */, DE66EDD308ABEC9000323D32 /* JIT */, DE66EDC408ABEC9000323D32 /* ExecutionEngine.cpp */, + 9F502B090D1D8D8D007939DF /* ExecutionEngineBindings.cpp */, ); name = lib/ExecutionEngine; path = ../lib/ExecutionEngine; diff --git a/bindings/ocaml/Makefile b/bindings/ocaml/Makefile index 11abec4f09c..89d05df618b 100644 --- a/bindings/ocaml/Makefile +++ b/bindings/ocaml/Makefile @@ -8,6 +8,6 @@ ##===----------------------------------------------------------------------===## LEVEL := ../.. -DIRS = llvm bitreader bitwriter analysis +DIRS = llvm bitreader bitwriter analysis executionengine include $(LEVEL)/Makefile.common diff --git a/bindings/ocaml/Makefile.ocaml b/bindings/ocaml/Makefile.ocaml index b7f4fdec29f..6008c3a0831 100644 --- a/bindings/ocaml/Makefile.ocaml +++ b/bindings/ocaml/Makefile.ocaml @@ -41,13 +41,18 @@ OCAMLAFLAGS += $(patsubst %,-cclib %, \ $(filter-out -L$(LibDir),-l$(LIBRARYNAME) \ $(shell $(LLVM_CONFIG) --ldflags)) \ $(UsedLibs)) + +ifneq ($(ENABLE_OPTIMIZED),1) + OCAMLDEBUGFLAG := -g +endif -Compile.CMI := $(strip $(OCAMLC) -c $(OCAMLCFLAGS) -o) -Compile.CMO := $(strip $(OCAMLC) -c $(OCAMLCFLAGS) -o) -Archive.CMA := $(strip $(OCAMLC) -a -custom $(OCAMLAFLAGS) -o) +Compile.CMI := $(strip $(OCAMLC) -c $(OCAMLCFLAGS) $(OCAMLDEBUGFLAG) -o) +Compile.CMO := $(strip $(OCAMLC) -c $(OCAMLCFLAGS) $(OCAMLDEBUGFLAG) -o) +Archive.CMA := $(strip $(OCAMLC) -a -custom $(OCAMLAFLAGS) $(OCAMLDEBUGFLAG) \ + -o) -Compile.CMX := $(strip $(OCAMLOPT) -c $(OCAMLCFLAGS) -o) -Archive.CMXA := $(strip $(OCAMLOPT) -a $(OCAMLAFLAGS) -o) +Compile.CMX := $(strip $(OCAMLOPT) -c $(OCAMLCFLAGS) $(OCAMLDEBUGFLAG) -o) +Archive.CMXA := $(strip $(OCAMLOPT) -a $(OCAMLAFLAGS) $(OCAMLDEBUGFLAG) -o) # Source files OcamlSources1 := $(sort $(wildcard $(PROJ_SRC_DIR)/*.ml)) @@ -137,6 +142,9 @@ build-deplibs: $(OutputLibs) $(OcamlDir)/%.a: $(LibDir)/%.a $(Verb) ln -sf $< $@ +$(OcamlDir)/%.o: $(LibDir)/%.o + $(Verb) ln -sf $< $@ + clean-deplibs: $(Verb) rm -f $(OutputLibs) diff --git a/bindings/ocaml/bitreader/bitreader_ocaml.c b/bindings/ocaml/bitreader/bitreader_ocaml.c index 87477f6312d..980ed2abbfc 100644 --- a/bindings/ocaml/bitreader/bitreader_ocaml.c +++ b/bindings/ocaml/bitreader/bitreader_ocaml.c @@ -14,9 +14,8 @@ #include "llvm-c/BitReader.h" #include "caml/alloc.h" -#include "caml/mlvalues.h" +#include "caml/fail.h" #include "caml/memory.h" -#include /* Can't use the recommended caml_named_value mechanism for backwards @@ -29,7 +28,17 @@ CAMLprim value llvm_register_bitreader_exns(value Error) { return Val_unit; } -void llvm_raise(value Prototype, char *Message); +static void llvm_raise(value Prototype, char *Message) { + CAMLparam1(Prototype); + CAMLlocal1(CamlMessage); + + CamlMessage = copy_string(Message); + LLVMDisposeMessage(Message); + + raise_with_arg(Prototype, CamlMessage); + abort(); /* NOTREACHED */ + CAMLnoreturn; +} /*===-- Modules -----------------------------------------------------------===*/ diff --git a/bindings/ocaml/executionengine/Makefile b/bindings/ocaml/executionengine/Makefile new file mode 100644 index 00000000000..2d95b12280d --- /dev/null +++ b/bindings/ocaml/executionengine/Makefile @@ -0,0 +1,20 @@ +##===- bindings/ocaml/executionengine/Makefile --------------*- Makefile -*-===## +# +# The LLVM Compiler Infrastructure +# +# This file was developed by Gordon Henriksen and is distributed under the +# University of Illinois Open Source License. See LICENSE.TXT for details. +# +##===----------------------------------------------------------------------===## +# +# This is the makefile for the Objective Caml Llvm_executionengine interface. +# +##===----------------------------------------------------------------------===## + +LEVEL := ../../.. +LIBRARYNAME := llvm_executionengine +DONT_BUILD_RELINKED := 1 +UsedComponents := executionengine jit interpreter native +UsedOcamlInterfaces := llvm + +include ../Makefile.ocaml diff --git a/bindings/ocaml/executionengine/executionengine_ocaml.c b/bindings/ocaml/executionengine/executionengine_ocaml.c new file mode 100644 index 00000000000..816c966104a --- /dev/null +++ b/bindings/ocaml/executionengine/executionengine_ocaml.c @@ -0,0 +1,301 @@ +/*===-- analysis_ocaml.c - LLVM Ocaml Glue ----------------------*- C++ -*-===*\ +|* *| +|* The LLVM Compiler Infrastructure *| +|* *| +|* This file was developed by Gordon Henriksen and is distributed under the *| +|* University of Illinois Open Source License. See LICENSE.TXT for details. *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's ocaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/ExecutionEngine.h" +#include "caml/alloc.h" +#include "caml/custom.h" +#include "caml/fail.h" +#include "caml/memory.h" +#include +#include + + +/* Can't use the recommended caml_named_value mechanism for backwards + compatibility reasons. This is largely equivalent. */ +static value llvm_ee_error_exn; + +CAMLprim value llvm_register_ee_exns(value Error) { + llvm_ee_error_exn = Field(Error, 0); + register_global_root(&llvm_ee_error_exn); + return Val_unit; +} + +static void llvm_raise(value Prototype, char *Message) { + CAMLparam1(Prototype); + CAMLlocal1(CamlMessage); + + CamlMessage = copy_string(Message); + LLVMDisposeMessage(Message); + + raise_with_arg(Prototype, CamlMessage); + abort(); /* NOTREACHED */ + CAMLnoreturn; +} + + +/*--... 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 *) "LLVMGenericValue", + llvm_finalize_generic_value, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_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) { + return alloc_generic_value(LLVMCreateGenericValueOfFloat(Ty, Double_val(N))); +} + +/* 'a -> t */ +CAMLprim value llvm_genericvalue_of_value(value V) { + return 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) { + return alloc_generic_value(LLVMCreateGenericValueOfInt(Ty, Int32_val(Int32), + 1)); +} + +/* Llvm.lltype -> nativeint -> t */ +CAMLprim value llvm_genericvalue_of_nativeint(LLVMTypeRef Ty, value NatInt) { + return alloc_generic_value(LLVMCreateGenericValueOfInt(Ty, + Nativeint_val(NatInt), + 1)); +} + +/* Llvm.lltype -> int64 -> t */ +CAMLprim value llvm_genericvalue_of_int64(LLVMTypeRef Ty, value Int64) { + return alloc_generic_value(LLVMCreateGenericValueOfInt(Ty, Int64_val(Int64), + 1)); +} + +/* Llvm.lltype -> t -> float */ +CAMLprim value llvm_genericvalue_as_float(LLVMTypeRef Ty, value GenVal) { + return copy_double(LLVMGenericValueToFloat(Ty, Genericvalue_val(GenVal))); +} + +/* t -> 'a */ +CAMLprim value llvm_genericvalue_as_value(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) { + assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 32 + && "Generic value too wide to treat as an int32!"); + return copy_int32(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)); +} + +/* t -> int64 */ +CAMLprim value llvm_genericvalue_as_int64(value GenVal) { + assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 64 + && "Generic value too wide to treat as an int64!"); + return copy_int64(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)); +} + +/* t -> nativeint */ +CAMLprim value llvm_genericvalue_as_nativeint(value GenVal) { + assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 8 * sizeof(value) + && "Generic value too wide to treat as a nativeint!"); + return copy_nativeint(LLVMGenericValueToInt(Genericvalue_val(GenVal),1)); +} + + +/*--... Operations on execution engines ....................................--*/ + +/* llmoduleprovider -> ExecutionEngine.t */ +CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleProviderRef MP) { + LLVMExecutionEngineRef Interp; + char *Error; + if (LLVMCreateExecutionEngine(&Interp, MP, &Error)) + llvm_raise(llvm_ee_error_exn, Error); + return Interp; +} + +/* llmoduleprovider -> ExecutionEngine.t */ +CAMLprim LLVMExecutionEngineRef +llvm_ee_create_interpreter(LLVMModuleProviderRef MP) { + LLVMExecutionEngineRef Interp; + char *Error; + if (LLVMCreateInterpreter(&Interp, MP, &Error)) + llvm_raise(llvm_ee_error_exn, Error); + return Interp; +} + +/* llmoduleprovider -> ExecutionEngine.t */ +CAMLprim LLVMExecutionEngineRef +llvm_ee_create_jit(LLVMModuleProviderRef MP) { + LLVMExecutionEngineRef JIT; + char *Error; + if (LLVMCreateJITCompiler(&JIT, MP, &Error)) + llvm_raise(llvm_ee_error_exn, Error); + return JIT; +} + +/* ExecutionEngine.t -> unit */ +CAMLprim value llvm_ee_dispose(LLVMExecutionEngineRef EE) { + LLVMDisposeExecutionEngine(EE); + return Val_unit; +} + +/* llmoduleprovider -> ExecutionEngine.t -> unit */ +CAMLprim value llvm_ee_add_mp(LLVMModuleProviderRef MP, + LLVMExecutionEngineRef EE) { + LLVMAddModuleProvider(EE, MP); + return Val_unit; +} + +/* llmoduleprovider -> ExecutionEngine.t -> llmodule */ +CAMLprim LLVMModuleRef llvm_ee_remove_mp(LLVMModuleProviderRef MP, + LLVMExecutionEngineRef EE) { + LLVMModuleRef RemovedModule; + char *Error; + if (LLVMRemoveModuleProvider(EE, MP, &RemovedModule, &Error)) + llvm_raise(llvm_ee_error_exn, 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, 1); + 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); +} + +/* ExecutionEngine.t -> unit */ +CAMLprim value llvm_ee_run_static_ctors(LLVMExecutionEngineRef EE) { + LLVMRunStaticConstructors(EE); + return Val_unit; +} + +/* ExecutionEngine.t -> unit */ +CAMLprim value llvm_ee_run_static_dtors(LLVMExecutionEngineRef EE) { + LLVMRunStaticDestructors(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; +} + diff --git a/bindings/ocaml/executionengine/llvm_executionengine.ml b/bindings/ocaml/executionengine/llvm_executionengine.ml new file mode 100644 index 00000000000..072e24901c8 --- /dev/null +++ b/bindings/ocaml/executionengine/llvm_executionengine.ml @@ -0,0 +1,106 @@ +(*===-- llvm_executionengine.ml - LLVM Ocaml Interface ----------*- C++ -*-===* + * + * The LLVM Compiler Infrastructure + * + * This file was developed by Gordon Henriksen and is distributed under the + * University of Illinois Open Source License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------===*) + + +exception Error of string + +external register_exns: exn -> unit + = "llvm_register_ee_exns" + + +module GenericValue = struct + type t + + external of_float: Llvm.lltype -> float -> t + = "llvm_genericvalue_of_float" + external of_pointer: 'a -> t + = "llvm_genericvalue_of_value" + 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_value" + 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 + + (* FIXME: Ocaml is not running this setup code unless we use 'val' in the + interface, which causes the emission of a stub for each function; + using 'external' in the module allows direct calls into + ocaml_executionengine.c. This is hardly fatal, but it is unnecessary + overhead on top of the two stubs that are already invoked for each + call into LLVM. *) + let _ = register_exns (Error "") + + external create: Llvm.llmoduleprovider -> t + = "llvm_ee_create" + external create_interpreter: Llvm.llmoduleprovider -> t + = "llvm_ee_create_interpreter" + external create_jit: Llvm.llmoduleprovider -> t + = "llvm_ee_create_jit" + external dispose: t -> unit + = "llvm_ee_dispose" + external add_module_provider: Llvm.llmoduleprovider -> t -> unit + = "llvm_ee_add_mp" + external remove_module_provider: Llvm.llmoduleprovider -> t -> Llvm.llmodule + = "llvm_ee_remove_mp" + 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" + + (* The following are not bound. Patches are welcome. + + get_target_data: t -> lltargetdata + 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 diff --git a/bindings/ocaml/executionengine/llvm_executionengine.mli b/bindings/ocaml/executionengine/llvm_executionengine.mli new file mode 100644 index 00000000000..a359774a86b --- /dev/null +++ b/bindings/ocaml/executionengine/llvm_executionengine.mli @@ -0,0 +1,152 @@ +(*===-- llvm_executionengine.mli - LLVM Ocaml Interface ---------*- C++ -*-===* + * + * The LLVM Compiler Infrastructure + * + * This file was developed by Gordon Henriksen and is distributed under the + * University of Illinois Open Source License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------=== + * + * This interface provides an ocaml API for LLVM execution engine (JIT/ + * interpreter), the classes in the ExecutionEngine library. + * + *===----------------------------------------------------------------------===*) + + +exception Error of string + + +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 + + (** [create mp] creates a new execution engine, taking ownership of the + module provider [mp] 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::ExecutionEngine::create]. **) + val create: Llvm.llmoduleprovider -> t + + (** [create_interpreter mp] creates a new interpreter, taking ownership of the + module provider [mp] 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::ExecutionEngine::create]. **) + val create_interpreter: Llvm.llmoduleprovider -> t + + (** [create_jit mp] creates a new JIT (just-in-time compiler), taking + ownership of the module provider [mp] 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::ExecutionEngine::create]. **) + val create_jit: Llvm.llmoduleprovider -> 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_provider mp ee] adds the module provider [mp] to the execution + engine [ee]. **) + val add_module_provider: Llvm.llmoduleprovider -> t -> unit + + (** [remove_module_provider mp ee] removes the module provider [mp] from the + execution engine [ee], disposing of [mp] and the module referenced by + [mp]. Raises [Error msg] if an error occurs. **) + val remove_module_provider: Llvm.llmoduleprovider -> 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 +end diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 506b5294dea..7224439feba 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -18,7 +18,6 @@ #include "llvm-c/Core.h" #include "caml/alloc.h" #include "caml/custom.h" -#include "caml/mlvalues.h" #include "caml/memory.h" #include "caml/fail.h" #include "caml/callback.h" @@ -37,7 +36,7 @@ CAMLprim value llvm_register_core_exns(value IoError) { return Val_unit; } -void llvm_raise(value Prototype, char *Message) { +static void llvm_raise(value Prototype, char *Message) { CAMLparam1(Prototype); CAMLlocal1(CamlMessage); @@ -45,6 +44,7 @@ void llvm_raise(value Prototype, char *Message) { LLVMDisposeMessage(Message); raise_with_arg(Prototype, CamlMessage); + abort(); /* NOTREACHED */ CAMLnoreturn; } @@ -234,7 +234,7 @@ CAMLprim LLVMTypeRef llvm_opaque_type(value Unit) { #define Typehandle_val(v) (*(LLVMTypeHandleRef *)(Data_custom_val(v))) -void llvm_finalize_handle(value TH) { +static void llvm_finalize_handle(value TH) { LLVMDisposeTypeHandle(Typehandle_val(TH)); } diff --git a/include/llvm-c/ExecutionEngine.h b/include/llvm-c/ExecutionEngine.h new file mode 100644 index 00000000000..f501086818a --- /dev/null +++ b/include/llvm-c/ExecutionEngine.h @@ -0,0 +1,115 @@ +/*===-- llvm-c/ExecutionEngine.h - ExecutionEngine Lib C Iface --*- C++ -*-===*\ +|* *| +|* The LLVM Compiler Infrastructure *| +|* *| +|* This file was developed by Gordon Henriksen and is distributed under the *| +|* University of Illinois Open Source License. See LICENSE.TXT for details. *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This header declares the C interface to libLLVMExecutionEngine.o, which *| +|* implements various analyses of the LLVM IR. *| +|* *| +|* Many exotic languages can interoperate with C code but have a harder time *| +|* with C++ due to name mangling. So in addition to C, this interface enables *| +|* tools written in such languages. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#ifndef LLVM_C_EXECUTIONENGINE_H +#define LLVM_C_EXECUTIONENGINE_H + +#include "llvm-c/Core.h" + +#ifdef __cplusplus +extern "C" { +#endif + +typedef struct LLVMOpaqueGenericValue *LLVMGenericValueRef; +typedef struct LLVMOpaqueExecutionEngine *LLVMExecutionEngineRef; + +/*===-- Operations on generic values --------------------------------------===*/ + +LLVMGenericValueRef LLVMCreateGenericValueOfInt(LLVMTypeRef Ty, + unsigned long long N, + int IsSigned); + +LLVMGenericValueRef LLVMCreateGenericValueOfPointer(void *P); + +LLVMGenericValueRef LLVMCreateGenericValueOfFloat(LLVMTypeRef Ty, double N); + +unsigned LLVMGenericValueIntWidth(LLVMGenericValueRef GenValRef); + +unsigned long long LLVMGenericValueToInt(LLVMGenericValueRef GenVal, + int IsSigned); + +void *LLVMGenericValueToPointer(LLVMGenericValueRef GenVal); + +double LLVMGenericValueToFloat(LLVMTypeRef TyRef, LLVMGenericValueRef GenVal); + +void LLVMDisposeGenericValue(LLVMGenericValueRef GenVal); + +/*===-- Operations on execution engines -----------------------------------===*/ + +int LLVMCreateExecutionEngine(LLVMExecutionEngineRef *OutEE, + LLVMModuleProviderRef MP, + char **OutError); + +int LLVMCreateInterpreter(LLVMExecutionEngineRef *OutInterp, + LLVMModuleProviderRef MP, + char **OutError); + +int LLVMCreateJITCompiler(LLVMExecutionEngineRef *OutJIT, + LLVMModuleProviderRef MP, + char **OutError); + +void LLVMDisposeExecutionEngine(LLVMExecutionEngineRef EE); + +void LLVMRunStaticConstructors(LLVMExecutionEngineRef EE); + +void LLVMRunStaticDestructors(LLVMExecutionEngineRef EE); + +int LLVMRunFunctionAsMain(LLVMExecutionEngineRef EE, LLVMValueRef F, + unsigned ArgC, const char * const *ArgV, + const char * const *EnvP); + +LLVMGenericValueRef LLVMRunFunction(LLVMExecutionEngineRef EE, LLVMValueRef F, + unsigned NumArgs, + LLVMGenericValueRef *Args); + +void LLVMFreeMachineCodeForFunction(LLVMExecutionEngineRef EE, LLVMValueRef F); + +void LLVMAddModuleProvider(LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP); + +int LLVMRemoveModuleProvider(LLVMExecutionEngineRef EE, + LLVMModuleProviderRef MP, + LLVMModuleRef *OutMod, char **OutError); + +int LLVMFindFunction(LLVMExecutionEngineRef EE, const char *Name, + LLVMValueRef *OutFn); + +#ifdef __cplusplus +} + +namespace llvm { + class GenericValue; + class ExecutionEngine; + + #define DEFINE_SIMPLE_CONVERSION_FUNCTIONS(ty, ref) \ + inline ty *unwrap(ref P) { \ + return reinterpret_cast(P); \ + } \ + \ + inline ref wrap(const ty *P) { \ + return reinterpret_cast(const_cast(P)); \ + } + + DEFINE_SIMPLE_CONVERSION_FUNCTIONS(GenericValue, LLVMGenericValueRef ) + DEFINE_SIMPLE_CONVERSION_FUNCTIONS(ExecutionEngine, LLVMExecutionEngineRef) + + #undef DEFINE_SIMPLE_CONVERSION_FUNCTIONS +} + +#endif /* defined(__cplusplus) */ + +#endif diff --git a/lib/ExecutionEngine/ExecutionEngineBindings.cpp b/lib/ExecutionEngine/ExecutionEngineBindings.cpp new file mode 100644 index 00000000000..6ef3632c29a --- /dev/null +++ b/lib/ExecutionEngine/ExecutionEngineBindings.cpp @@ -0,0 +1,187 @@ +//===-- ExecutionEngineBindings.cpp - C bindings for EEs ------------------===// +// +// The LLVM Compiler Infrastructure +// +// This file was developed by Gordon Henriksen and is distributed under the +// University of Illinois Open Source License. See LICENSE.TXT for details. +// +//===----------------------------------------------------------------------===// +// +// This file defines the C bindings for the ExecutionEngine library. +// +//===----------------------------------------------------------------------===// + +#define DEBUG_TYPE "jit" +#include "llvm-c/ExecutionEngine.h" +#include "llvm/ExecutionEngine/GenericValue.h" +#include "llvm/ExecutionEngine/ExecutionEngine.h" + +using namespace llvm; + +/*===-- Operations on generic values --------------------------------------===*/ + +LLVMGenericValueRef LLVMCreateGenericValueOfInt(LLVMTypeRef Ty, + unsigned long long N, + int IsSigned) { + GenericValue *GenVal = new GenericValue(); + GenVal->IntVal = APInt(unwrap(Ty)->getBitWidth(), N, IsSigned); + return wrap(GenVal); +} + +LLVMGenericValueRef LLVMCreateGenericValueOfPointer(void *P) { + GenericValue *GenVal = new GenericValue(); + GenVal->PointerVal = P; + return wrap(GenVal); +} + +LLVMGenericValueRef LLVMCreateGenericValueOfFloat(LLVMTypeRef TyRef, double N) { + GenericValue *GenVal = new GenericValue(); + switch (unwrap(TyRef)->getTypeID()) { + case Type::FloatTyID: + GenVal->FloatVal = N; + break; + case Type::DoubleTyID: + GenVal->DoubleVal = N; + break; + default: + assert(0 && "LLVMGenericValueToFloat supports only float and double."); + break; + } + return wrap(GenVal); +} + +unsigned LLVMGenericValueIntWidth(LLVMGenericValueRef GenValRef) { + return unwrap(GenValRef)->IntVal.getBitWidth(); +} + +unsigned long long LLVMGenericValueToInt(LLVMGenericValueRef GenValRef, + int IsSigned) { + GenericValue *GenVal = unwrap(GenValRef); + if (IsSigned) + return GenVal->IntVal.getSExtValue(); + else + return GenVal->IntVal.getZExtValue(); +} + +void *LLVMGenericValueToPointer(LLVMGenericValueRef GenVal) { + return unwrap(GenVal)->PointerVal; +} + +double LLVMGenericValueToFloat(LLVMTypeRef TyRef, LLVMGenericValueRef GenVal) { + switch (unwrap(TyRef)->getTypeID()) { + case Type::FloatTyID: + return unwrap(GenVal)->FloatVal; + case Type::DoubleTyID: + return unwrap(GenVal)->DoubleVal; + default: + assert(0 && "LLVMGenericValueToFloat supports only float and double."); + break; + } +} + +void LLVMDisposeGenericValue(LLVMGenericValueRef GenVal) { + delete unwrap(GenVal); +} + +/*===-- Operations on execution engines -----------------------------------===*/ + +int LLVMCreateExecutionEngine(LLVMExecutionEngineRef *OutEE, + LLVMModuleProviderRef MP, + char **OutError) { + std::string Error; + if (ExecutionEngine *EE = ExecutionEngine::create(unwrap(MP), false, &Error)){ + *OutEE = wrap(EE); + return 0; + } + *OutError = strdup(Error.c_str()); + return 1; +} + +int LLVMCreateInterpreter(LLVMExecutionEngineRef *OutInterp, + LLVMModuleProviderRef MP, + char **OutError) { + std::string Error; + if (ExecutionEngine *Interp = ExecutionEngine::create(unwrap(MP), &Error)) { + *OutInterp = wrap(Interp); + return 0; + } + *OutError = strdup(Error.c_str()); + return 1; +} + +int LLVMCreateJITCompiler(LLVMExecutionEngineRef *OutJIT, + LLVMModuleProviderRef MP, + char **OutError) { + std::string Error; + if (ExecutionEngine *JIT = ExecutionEngine::createJIT(unwrap(MP), &Error)) { + *OutJIT = wrap(JIT); + return 0; + } + *OutError = strdup(Error.c_str()); + return 1; +} + +void LLVMDisposeExecutionEngine(LLVMExecutionEngineRef EE) { + delete unwrap(EE); +} + +void LLVMRunStaticConstructors(LLVMExecutionEngineRef EE) { + unwrap(EE)->runStaticConstructorsDestructors(false); +} + +void LLVMRunStaticDestructors(LLVMExecutionEngineRef EE) { + unwrap(EE)->runStaticConstructorsDestructors(true); +} + +int LLVMRunFunctionAsMain(LLVMExecutionEngineRef EE, LLVMValueRef F, + unsigned ArgC, const char * const *ArgV, + const char * const *EnvP) { + std::vector ArgVec; + for (unsigned I = 0; I != ArgC; ++I) + ArgVec.push_back(ArgV[I]); + + return unwrap(EE)->runFunctionAsMain(unwrap(F), ArgVec, EnvP); +} + +LLVMGenericValueRef LLVMRunFunction(LLVMExecutionEngineRef EE, LLVMValueRef F, + unsigned NumArgs, + LLVMGenericValueRef *Args) { + std::vector ArgVec; + ArgVec.reserve(NumArgs); + for (unsigned I = 0; I != NumArgs; ++I) + ArgVec.push_back(*unwrap(Args[I])); + + GenericValue *Result = new GenericValue(); + *Result = unwrap(EE)->runFunction(unwrap(F), ArgVec); + return wrap(Result); +} + +void LLVMFreeMachineCodeForFunction(LLVMExecutionEngineRef EE, LLVMValueRef F) { + unwrap(EE)->freeMachineCodeForFunction(unwrap(F)); +} + +void LLVMAddModuleProvider(LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP){ + unwrap(EE)->addModuleProvider(unwrap(MP)); +} + +int LLVMRemoveModuleProvider(LLVMExecutionEngineRef EE, + LLVMModuleProviderRef MP, + LLVMModuleRef *OutMod, char **OutError) { + std::string Error; + if (Module *Gone = unwrap(EE)->removeModuleProvider(unwrap(MP), &Error)) { + *OutMod = wrap(Gone); + return 0; + } + if (OutError) + *OutError = strdup(Error.c_str()); + return 1; +} + +int LLVMFindFunction(LLVMExecutionEngineRef EE, const char *Name, + LLVMValueRef *OutFn) { + if (Function *F = unwrap(EE)->FindFunctionNamed(Name)) { + *OutFn = wrap(F); + return 0; + } + return 1; +} diff --git a/test/Bindings/Ocaml/executionengine.ml b/test/Bindings/Ocaml/executionengine.ml new file mode 100644 index 00000000000..d2ba147c163 --- /dev/null +++ b/test/Bindings/Ocaml/executionengine.ml @@ -0,0 +1,101 @@ +(* RUN: %ocamlc -warn-error A llvm.cma llvm_executionengine.cma %s -o %t + * RUN: ./%t %t.bc + *) + +open Llvm +open Llvm_executionengine + +(* Note that this takes a moment to link, so it's best to keep the number of + individual tests low. *) + +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 b = builder_at_end (entry_block fn) in + ignore (build_ret (const_int i32_type retval) b); + fn + +let define_plus m = + let fn = define_function "plus" (function_type i32_type [| i32_type; + i32_type |]) m in + let b = builder_at_end (entry_block fn) in + let add = build_add (param fn 0) (param fn 1) "sum" b in + ignore (build_ret add b) + +let test_genericvalue () = + let tu = (1, 2) in + let ptrgv = GenericValue.of_pointer tu in + assert (tu = GenericValue.as_pointer ptrgv); + + 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 4l in + assert (4l = GenericValue.as_int32 i32gv); + + let nigv = GenericValue.of_nativeint i32_type 5n in + assert (5n = GenericValue.as_nativeint nigv); + + let i64gv = GenericValue.of_int64 i64_type 6L in + assert (6L = GenericValue.as_int64 i64gv) + +let test_executionengine () = + (* create *) + let m = create_module "test_module" in + let main = define_main_fn m 42 in + + let m2 = create_module "test_module2" in + define_plus m2; + + let ee = ExecutionEngine.create (ModuleProvider.create m) in + let mp2 = ModuleProvider.create m2 in + ExecutionEngine.add_module_provider mp2 ee; + + (* 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 -> + + (* 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"; + + (* remove_module_provider *) + Llvm.dispose_module (ExecutionEngine.remove_module_provider mp2 ee); + + (* run_static_dtors *) + ExecutionEngine.run_static_dtors ee; + + (* dispose *) + ExecutionEngine.dispose ee + +let _ = + test_genericvalue (); + test_executionengine () -- 2.34.1