From 2e855e68d861224c9b61e2bc9cecad1536b1534b Mon Sep 17 00:00:00 2001 From: Gordon Henriksen Date: Sun, 23 Dec 2007 16:59:28 +0000 Subject: 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 --- bindings/ocaml/Makefile | 2 +- bindings/ocaml/Makefile.ocaml | 18 +- bindings/ocaml/bitreader/bitreader_ocaml.c | 15 +- bindings/ocaml/executionengine/Makefile | 20 ++ .../ocaml/executionengine/executionengine_ocaml.c | 301 +++++++++++++++++++++ .../ocaml/executionengine/llvm_executionengine.ml | 106 ++++++++ .../ocaml/executionengine/llvm_executionengine.mli | 152 +++++++++++ bindings/ocaml/llvm/llvm_ocaml.c | 6 +- 8 files changed, 608 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 (limited to 'bindings') diff --git a/bindings/ocaml/Makefile b/bindings/ocaml/Makefile index 11abec4f09..89d05df618 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 b7f4fdec29..6008c3a083 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 87477f6312..980ed2abbf 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 0000000000..2d95b12280 --- /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 0000000000..816c966104 --- /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 0000000000..072e24901c --- /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 0000000000..a359774a86 --- /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 506b5294de..7224439feb 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)); } -- cgit v1.2.3