diff options
Diffstat (limited to 'bindings/ocaml')
| -rw-r--r-- | bindings/ocaml/bitreader/bitreader_ocaml.c | 9 | ||||
| -rw-r--r-- | bindings/ocaml/bitreader/llvm_bitreader.ml | 5 | ||||
| -rw-r--r-- | bindings/ocaml/bitreader/llvm_bitreader.mli | 14 | ||||
| -rw-r--r-- | bindings/ocaml/bitwriter/bitwriter_ocaml.c | 15 | ||||
| -rw-r--r-- | bindings/ocaml/bitwriter/llvm_bitwriter.ml | 7 | ||||
| -rw-r--r-- | bindings/ocaml/bitwriter/llvm_bitwriter.mli | 12 | ||||
| -rw-r--r-- | bindings/ocaml/executionengine/executionengine_ocaml.c | 49 | ||||
| -rw-r--r-- | bindings/ocaml/executionengine/llvm_executionengine.ml | 20 | ||||
| -rw-r--r-- | bindings/ocaml/executionengine/llvm_executionengine.mli | 109 | ||||
| -rw-r--r-- | bindings/ocaml/llvm/llvm.ml | 137 | ||||
| -rw-r--r-- | bindings/ocaml/llvm/llvm.mli | 355 | ||||
| -rw-r--r-- | bindings/ocaml/llvm/llvm_ocaml.c | 298 | ||||
| -rw-r--r-- | bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml | 59 | ||||
| -rw-r--r-- | bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli | 91 | ||||
| -rw-r--r-- | bindings/ocaml/transforms/scalar/scalar_opts_ocaml.c | 96 |
15 files changed, 1039 insertions, 237 deletions
diff --git a/bindings/ocaml/bitreader/bitreader_ocaml.c b/bindings/ocaml/bitreader/bitreader_ocaml.c index 5fd9f85..ef72ce2 100644 --- a/bindings/ocaml/bitreader/bitreader_ocaml.c +++ b/bindings/ocaml/bitreader/bitreader_ocaml.c @@ -46,17 +46,16 @@ static void llvm_raise(value Prototype, char *Message) { /*===-- Modules -----------------------------------------------------------===*/ /* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */ -CAMLprim value llvm_get_module_provider(LLVMContextRef C, - LLVMMemoryBufferRef MemBuf) { +CAMLprim value llvm_get_module(LLVMContextRef C, LLVMMemoryBufferRef MemBuf) { CAMLparam0(); CAMLlocal2(Variant, MessageVal); char *Message; - LLVMModuleProviderRef MP; - if (LLVMGetBitcodeModuleProviderInContext(C, MemBuf, &MP, &Message)) + LLVMModuleRef M; + if (LLVMGetBitcodeModuleInContext(C, MemBuf, &M, &Message)) llvm_raise(llvm_bitreader_error_exn, Message); - CAMLreturn((value) MemBuf); + CAMLreturn((value) M); } /* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */ diff --git a/bindings/ocaml/bitreader/llvm_bitreader.ml b/bindings/ocaml/bitreader/llvm_bitreader.ml index 88587cb..8b9d01d 100644 --- a/bindings/ocaml/bitreader/llvm_bitreader.ml +++ b/bindings/ocaml/bitreader/llvm_bitreader.ml @@ -13,9 +13,8 @@ exception Error of string external register_exns : exn -> unit = "llvm_register_bitreader_exns" let _ = register_exns (Error "") -external get_module_provider : Llvm.llcontext -> Llvm.llmemorybuffer -> - Llvm.llmoduleprovider - = "llvm_get_module_provider" +external get_module : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule + = "llvm_get_module" external parse_bitcode : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule = "llvm_parse_bitcode" diff --git a/bindings/ocaml/bitreader/llvm_bitreader.mli b/bindings/ocaml/bitreader/llvm_bitreader.mli index 5648b35..5e22409 100644 --- a/bindings/ocaml/bitreader/llvm_bitreader.mli +++ b/bindings/ocaml/bitreader/llvm_bitreader.mli @@ -14,14 +14,12 @@ exception Error of string -(** [get_module_provider context mb] reads the bitcode for a new - module provider [m] from the memory buffer [mb] in the context [context]. - Returns [m] if successful, or raises [Error msg] otherwise, where [msg] is a - description of the error encountered. See the function - [llvm::getBitcodeModuleProvider]. *) -external get_module_provider : Llvm.llcontext -> Llvm.llmemorybuffer -> - Llvm.llmoduleprovider - = "llvm_get_module_provider" +(** [get_module context mb] reads the bitcode for a new module [m] from the + memory buffer [mb] in the context [context]. Returns [m] if successful, or + raises [Error msg] otherwise, where [msg] is a description of the error + encountered. See the function [llvm::getBitcodeModule]. *) +external get_module : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule + = "llvm_get_module" (** [parse_bitcode context mb] parses the bitcode for a new module [m] from the memory buffer [mb] in the context [context]. Returns [m] if successful, or diff --git a/bindings/ocaml/bitwriter/bitwriter_ocaml.c b/bindings/ocaml/bitwriter/bitwriter_ocaml.c index 41aca25..53c93cb 100644 --- a/bindings/ocaml/bitwriter/bitwriter_ocaml.c +++ b/bindings/ocaml/bitwriter/bitwriter_ocaml.c @@ -28,3 +28,18 @@ CAMLprim value llvm_write_bitcode_file(value M, value Path) { int res = LLVMWriteBitcodeToFile((LLVMModuleRef) M, String_val(Path)); return Val_bool(res == 0); } + +/* ?unbuffered:bool -> Llvm.llmodule -> Unix.file_descr -> bool */ +CAMLprim value llvm_write_bitcode_to_fd(value U, value M, value FD) { + int Unbuffered; + int res; + + if (U == Val_int(0)) { + Unbuffered = 0; + } else { + Unbuffered = Bool_val(Field(U,0)); + } + + res = LLVMWriteBitcodeToFD((LLVMModuleRef) M, Int_val(FD), 0, Unbuffered); + return Val_bool(res == 0); +} diff --git a/bindings/ocaml/bitwriter/llvm_bitwriter.ml b/bindings/ocaml/bitwriter/llvm_bitwriter.ml index 7b45c53..3e69a3c 100644 --- a/bindings/ocaml/bitwriter/llvm_bitwriter.ml +++ b/bindings/ocaml/bitwriter/llvm_bitwriter.ml @@ -16,3 +16,10 @@ (* Writes the bitcode for module the given path. Returns true if successful. *) external write_bitcode_file : Llvm.llmodule -> string -> bool = "llvm_write_bitcode_file" + +external write_bitcode_to_fd : ?unbuffered:bool -> Llvm.llmodule + -> Unix.file_descr -> bool + = "llvm_write_bitcode_to_fd" + +let output_bitcode ?unbuffered channel m = + write_bitcode_to_fd ?unbuffered m (Unix.descr_of_out_channel channel) diff --git a/bindings/ocaml/bitwriter/llvm_bitwriter.mli b/bindings/ocaml/bitwriter/llvm_bitwriter.mli index 2f782a1..ea9a876 100644 --- a/bindings/ocaml/bitwriter/llvm_bitwriter.mli +++ b/bindings/ocaml/bitwriter/llvm_bitwriter.mli @@ -16,3 +16,15 @@ [path]. Returns [true] if successful, [false] otherwise. *) external write_bitcode_file : Llvm.llmodule -> string -> bool = "llvm_write_bitcode_file" + +(** [write_bitcode_to_fd ~unbuffered fd m] writes the bitcode for module + [m] to the channel [c]. If [unbuffered] is [true], after every write the fd + will be flushed. Returns [true] if successful, [false] otherwise. *) +external write_bitcode_to_fd : ?unbuffered:bool -> Llvm.llmodule + -> Unix.file_descr -> bool + = "llvm_write_bitcode_to_fd" + +(** [output_bitcode ~unbuffered c m] writes the bitcode for module [m] + to the channel [c]. If [unbuffered] is [true], after every write the fd + will be flushed. Returns [true] if successful, [false] otherwise. *) +val output_bitcode : ?unbuffered:bool -> out_channel -> Llvm.llmodule -> bool diff --git a/bindings/ocaml/executionengine/executionengine_ocaml.c b/bindings/ocaml/executionengine/executionengine_ocaml.c index 072d583..5b1e32e 100644 --- a/bindings/ocaml/executionengine/executionengine_ocaml.c +++ b/bindings/ocaml/executionengine/executionengine_ocaml.c @@ -91,7 +91,7 @@ CAMLprim value llvm_genericvalue_of_float(LLVMTypeRef Ty, value N) { } /* 'a -> t */ -CAMLprim value llvm_genericvalue_of_value(value V) { +CAMLprim value llvm_genericvalue_of_pointer(value V) { CAMLparam1(V); CAMLreturn(alloc_generic_value(LLVMCreateGenericValueOfPointer(Op_val(V)))); } @@ -130,7 +130,7 @@ CAMLprim value llvm_genericvalue_as_float(LLVMTypeRef Ty, value GenVal) { } /* t -> 'a */ -CAMLprim value llvm_genericvalue_as_value(value GenVal) { +CAMLprim value llvm_genericvalue_as_pointer(value GenVal) { return Val_op(LLVMGenericValueToPointer(Genericvalue_val(GenVal))); } @@ -168,41 +168,31 @@ CAMLprim value llvm_genericvalue_as_nativeint(value GenVal) { /*--... Operations on execution engines ....................................--*/ -/* llmoduleprovider -> ExecutionEngine.t */ -CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleProviderRef MP) { +/* llmodule -> ExecutionEngine.t */ +CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleRef M) { LLVMExecutionEngineRef Interp; char *Error; - if (LLVMCreateExecutionEngine(&Interp, MP, &Error)) + if (LLVMCreateExecutionEngineForModule(&Interp, M, &Error)) llvm_raise(llvm_ee_error_exn, Error); return Interp; } -/* llmoduleprovider -> ExecutionEngine.t */ +/* llmodule -> ExecutionEngine.t */ CAMLprim LLVMExecutionEngineRef -llvm_ee_create_interpreter(LLVMModuleProviderRef MP) { +llvm_ee_create_interpreter(LLVMModuleRef M) { LLVMExecutionEngineRef Interp; char *Error; - if (LLVMCreateInterpreter(&Interp, MP, &Error)) + if (LLVMCreateInterpreterForModule(&Interp, M, &Error)) llvm_raise(llvm_ee_error_exn, Error); return Interp; } -/* llmoduleprovider -> ExecutionEngine.t */ +/* llmodule -> int -> ExecutionEngine.t */ CAMLprim LLVMExecutionEngineRef -llvm_ee_create_jit(LLVMModuleProviderRef MP) { +llvm_ee_create_jit(LLVMModuleRef M, value OptLevel) { LLVMExecutionEngineRef JIT; char *Error; - if (LLVMCreateJITCompiler(&JIT, MP, 3, &Error)) - llvm_raise(llvm_ee_error_exn, Error); - return JIT; -} - -/* llmoduleprovider -> ExecutionEngine.t */ -CAMLprim LLVMExecutionEngineRef -llvm_ee_create_fast_jit(LLVMModuleProviderRef MP) { - LLVMExecutionEngineRef JIT; - char *Error; - if (LLVMCreateJITCompiler(&JIT, MP, 0, &Error)) + if (LLVMCreateJITCompilerForModule(&JIT, M, Int_val(OptLevel), &Error)) llvm_raise(llvm_ee_error_exn, Error); return JIT; } @@ -213,19 +203,18 @@ CAMLprim value llvm_ee_dispose(LLVMExecutionEngineRef EE) { return Val_unit; } -/* llmoduleprovider -> ExecutionEngine.t -> unit */ -CAMLprim value llvm_ee_add_mp(LLVMModuleProviderRef MP, - LLVMExecutionEngineRef EE) { - LLVMAddModuleProvider(EE, MP); +/* llmodule -> ExecutionEngine.t -> unit */ +CAMLprim value llvm_ee_add_module(LLVMModuleRef M, LLVMExecutionEngineRef EE) { + LLVMAddModule(EE, M); return Val_unit; } -/* llmoduleprovider -> ExecutionEngine.t -> llmodule */ -CAMLprim LLVMModuleRef llvm_ee_remove_mp(LLVMModuleProviderRef MP, - LLVMExecutionEngineRef EE) { +/* llmodule -> ExecutionEngine.t -> llmodule */ +CAMLprim LLVMModuleRef llvm_ee_remove_module(LLVMModuleRef M, + LLVMExecutionEngineRef EE) { LLVMModuleRef RemovedModule; char *Error; - if (LLVMRemoveModuleProvider(EE, MP, &RemovedModule, &Error)) + if (LLVMRemoveModule(EE, M, &RemovedModule, &Error)) llvm_raise(llvm_ee_error_exn, Error); return RemovedModule; } @@ -237,7 +226,7 @@ CAMLprim value llvm_ee_find_function(value Name, LLVMExecutionEngineRef EE) { LLVMValueRef Found; if (LLVMFindFunction(EE, String_val(Name), &Found)) CAMLreturn(Val_unit); - Option = alloc(1, 1); + Option = alloc(1, 0); Field(Option, 0) = Val_op(Found); CAMLreturn(Option); } diff --git a/bindings/ocaml/executionengine/llvm_executionengine.ml b/bindings/ocaml/executionengine/llvm_executionengine.ml index c9e8f18..a8535b2 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.ml +++ b/bindings/ocaml/executionengine/llvm_executionengine.ml @@ -20,7 +20,7 @@ module GenericValue = struct external of_float: Llvm.lltype -> float -> t = "llvm_genericvalue_of_float" external of_pointer: 'a -> t - = "llvm_genericvalue_of_value" + = "llvm_genericvalue_of_pointer" external of_int32: Llvm.lltype -> int32 -> t = "llvm_genericvalue_of_int32" external of_int: Llvm.lltype -> int -> t @@ -33,7 +33,7 @@ module GenericValue = struct external as_float: Llvm.lltype -> t -> float = "llvm_genericvalue_as_float" external as_pointer: t -> 'a - = "llvm_genericvalue_as_value" + = "llvm_genericvalue_as_pointer" external as_int32: t -> int32 = "llvm_genericvalue_as_int32" external as_int: t -> int @@ -56,20 +56,18 @@ module ExecutionEngine = struct call into LLVM. *) let _ = register_exns (Error "") - external create: Llvm.llmoduleprovider -> t + external create: Llvm.llmodule -> t = "llvm_ee_create" - external create_interpreter: Llvm.llmoduleprovider -> t + external create_interpreter: Llvm.llmodule -> t = "llvm_ee_create_interpreter" - external create_jit: Llvm.llmoduleprovider -> t + external create_jit: Llvm.llmodule -> int -> t = "llvm_ee_create_jit" - external create_fast_jit: Llvm.llmoduleprovider -> t - = "llvm_ee_create_fast_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 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 -> diff --git a/bindings/ocaml/executionengine/llvm_executionengine.mli b/bindings/ocaml/executionengine/llvm_executionengine.mli index 6c2fdfb..ce25f9d 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.mli +++ b/bindings/ocaml/executionengine/llvm_executionengine.mli @@ -25,57 +25,58 @@ module GenericValue: sig (** [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 + external of_float : Llvm.lltype -> float -> t = "llvm_genericvalue_of_float" (** [of_pointer v] boxes the pointer value [v] in a generic value. See the field [llvm::GenericValue::PointerVal]. *) - val of_pointer: 'a -> t + external of_pointer : 'a -> t = "llvm_genericvalue_of_pointer" (** [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 + external of_int32 : Llvm.lltype -> int32 -> t = "llvm_genericvalue_of_int32" (** [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 + external of_int : Llvm.lltype -> int -> t = "llvm_genericvalue_of_int" (** [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 - + external of_nativeint : Llvm.lltype -> nativeint -> t + = "llvm_genericvalue_of_nativeint" + (** [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 - + external of_int64 : Llvm.lltype -> int64 -> t = "llvm_genericvalue_of_int64" + (** [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 + external as_float : Llvm.lltype -> t -> float = "llvm_genericvalue_as_float" (** [as_pointer gv] unboxes the pointer-valued generic value [gv]. See the field [llvm::GenericValue::PointerVal]. *) - val as_pointer: t -> 'a + external as_pointer : t -> 'a = "llvm_genericvalue_as_pointer" (** [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 + external as_int32 : t -> int32 = "llvm_genericvalue_as_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 + external as_int : t -> int = "llvm_genericvalue_as_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 + external as_nativeint : t -> nativeint = "llvm_genericvalue_as_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 + external as_int64 : t -> int64 = "llvm_genericvalue_as_int64" end @@ -85,81 +86,77 @@ module ExecutionEngine: sig 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::EngineBuilder::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]. + (** [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_interpreter: Llvm.llmoduleprovider -> t + external create : Llvm.llmodule -> t = "llvm_ee_create" - (** [create_jit mp] creates a new JIT (just-in-time compiler), taking - ownership of the module provider [mp] if successful. This function creates - a JIT which favors code quality over compilation speed. Raises [Error msg] - if an error occurrs. The execution engine is not garbage collected and - must be destroyed with [dispose ee]. + (** [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_jit: Llvm.llmoduleprovider -> t + external create_interpreter : Llvm.llmodule -> t = "llvm_ee_create_interpreter" - (** [create_fast_jit mp] creates a new JIT (just-in-time compiler) which - favors compilation speed over code quality. It takes 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]. + (** [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_fast_jit: Llvm.llmoduleprovider -> t - + external create_jit : Llvm.llmodule -> int -> t = "llvm_ee_create_jit" + (** [dispose ee] releases the memory used by the execution engine and must be invoked to avoid memory leaks. *) - val dispose: t -> unit + external dispose : t -> unit = "llvm_ee_dispose" - (** [add_module_provider mp ee] adds the module provider [mp] to the execution - engine [ee]. *) - val add_module_provider: Llvm.llmoduleprovider -> t -> unit + (** [add_module m ee] adds the module [m] to the execution engine [ee]. *) + external add_module : Llvm.llmodule -> t -> unit = "llvm_ee_add_module" - (** [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 + (** [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. *) + external remove_module : Llvm.llmodule -> t -> Llvm.llmodule + = "llvm_ee_remove_module" (** [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 + external find_function : string -> t -> Llvm.llvalue option + = "llvm_ee_find_function" (** [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 + external run_function : Llvm.llvalue -> GenericValue.t array -> t -> + GenericValue.t + = "llvm_ee_run_function" (** [run_static_ctors ee] executes the static constructors of each module in the execution engine [ee]. *) - val run_static_ctors: t -> unit + external run_static_ctors : t -> unit = "llvm_ee_run_static_ctors" (** [run_static_dtors ee] executes the static destructors of each module in the execution engine [ee]. *) - val run_static_dtors: t -> unit + external run_static_dtors : t -> unit = "llvm_ee_run_static_dtors" (** [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 + external run_function_as_main : Llvm.llvalue -> string array -> + (string * string) array -> t -> int + = "llvm_ee_run_function_as_main" (** [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 + external free_machine_code : Llvm.llvalue -> t -> unit + = "llvm_ee_free_machine_code" (** [target_data ee] is the target data owned by the execution engine [ee]. *) - val target_data: t -> Llvm_target.TargetData.t + external target_data : t -> Llvm_target.TargetData.t + = "LLVMGetExecutionEngineTargetData" end external initialize_native_target : unit -> bool diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 7e4acbf..e801c49 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -13,9 +13,9 @@ type llmodule type lltype type lltypehandle type llvalue +type lluse type llbasicblock type llbuilder -type llmoduleprovider type llmemorybuffer module TypeKind = struct @@ -35,6 +35,7 @@ module TypeKind = struct | Opaque | Vector | Metadata + | Union end module Linkage = struct @@ -89,11 +90,13 @@ module Attribute = struct | Optsize | Ssp | Sspreq + | Alignment | Nocapture | Noredzone | Noimplicitfloat | Naked | Inlinehint + | Stackalignment end module Icmp = struct @@ -147,6 +150,7 @@ type ('a, 'b) llrev_pos = external create_context : unit -> llcontext = "llvm_create_context" external dispose_context : llcontext -> unit = "llvm_dispose_context" external global_context : unit -> llcontext = "llvm_global_context" +external mdkind_id : llcontext -> string -> int = "llvm_mdkind_id" (*===-- Modules -----------------------------------------------------------===*) external create_module : llcontext -> string -> llmodule = "llvm_create_module" @@ -163,6 +167,8 @@ external define_type_name : string -> lltype -> llmodule -> bool = "llvm_add_type_name" external delete_type_name : string -> llmodule -> unit = "llvm_delete_type_name" +external type_by_name : llmodule -> string -> lltype option + = "llvm_type_by_name" external dump_module : llmodule -> unit = "llvm_dump_module" (*===-- Types -------------------------------------------------------------===*) @@ -198,9 +204,15 @@ external param_types : lltype -> lltype array = "llvm_param_types" external struct_type : llcontext -> lltype array -> lltype = "llvm_struct_type" external packed_struct_type : llcontext -> lltype array -> lltype = "llvm_packed_struct_type" -external element_types : lltype -> lltype array = "llvm_element_types" +external struct_element_types : lltype -> lltype array + = "llvm_struct_element_types" external is_packed : lltype -> bool = "llvm_is_packed" +(*--... Operations on union types ..........................................--*) +external union_type : llcontext -> lltype array -> lltype = "llvm_union_type" +external union_element_types : lltype -> lltype array + = "llvm_union_element_types" + (*--... Operations on pointer, vector, and array types .....................--*) external array_type : lltype -> int -> lltype = "llvm_array_type" external pointer_type : lltype -> lltype = "llvm_pointer_type" @@ -229,15 +241,63 @@ external type_of : llvalue -> lltype = "llvm_type_of" external value_name : llvalue -> string = "llvm_value_name" external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" external dump_value : llvalue -> unit = "llvm_dump_value" +external replace_all_uses_with : llvalue -> llvalue -> unit + = "LLVMReplaceAllUsesWith" + +(*--... Operations on uses .................................................--*) +external use_begin : llvalue -> lluse option = "llvm_use_begin" +external use_succ : lluse -> lluse option = "llvm_use_succ" +external user : lluse -> llvalue = "llvm_user" +external used_value : lluse -> llvalue = "llvm_used_value" + +let iter_uses f v = + let rec aux = function + | None -> () + | Some u -> + f u; + aux (use_succ u) + in + aux (use_begin v) + +let fold_left_uses f init v = + let rec aux init u = + match u with + | None -> init + | Some u -> aux (f init u) (use_succ u) + in + aux init (use_begin v) + +let fold_right_uses f v init = + let rec aux u init = + match u with + | None -> init + | Some u -> f u (aux (use_succ u) init) + in + aux (use_begin v) init + + +(*--... Operations on users ................................................--*) +external operand : llvalue -> int -> llvalue = "llvm_operand" (*--... Operations on constants of (mostly) any type .......................--*) external is_constant : llvalue -> bool = "llvm_is_constant" external const_null : lltype -> llvalue = "LLVMConstNull" external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes" +external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull" external undef : lltype -> llvalue = "LLVMGetUndef" external is_null : llvalue -> bool = "llvm_is_null" external is_undef : llvalue -> bool = "llvm_is_undef" +(*--... Operations on instructions .........................................--*) +external has_metadata : llvalue -> bool = "llvm_has_metadata" +external metadata : llvalue -> int -> llvalue option = "llvm_metadata" +external set_metadata : llvalue -> int -> llvalue -> unit = "llvm_set_metadata" +external clear_metadata : llvalue -> int -> unit = "llvm_clear_metadata" + +(*--... Operations on metadata .......,.....................................--*) +external mdstring : llcontext -> string -> llvalue = "llvm_mdstring" +external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode" + (*--... Operations on scalar constants .....................................--*) external const_int : lltype -> int -> llvalue = "llvm_const_int" external const_of_int64 : lltype -> Int64.t -> bool -> llvalue @@ -257,19 +317,27 @@ external const_struct : llcontext -> llvalue array -> llvalue external const_packed_struct : llcontext -> llvalue array -> llvalue = "llvm_const_packed_struct" external const_vector : llvalue array -> llvalue = "llvm_const_vector" +external const_union : lltype -> llvalue -> llvalue = "LLVMConstUnion" (*--... Constant expressions ...............................................--*) external align_of : lltype -> llvalue = "LLVMAlignOf" external size_of : lltype -> llvalue = "LLVMSizeOf" external const_neg : llvalue -> llvalue = "LLVMConstNeg" +external const_nsw_neg : llvalue -> llvalue = "LLVMConstNSWNeg" +external const_nuw_neg : llvalue -> llvalue = "LLVMConstNUWNeg" external const_fneg : llvalue -> llvalue = "LLVMConstFNeg" external const_not : llvalue -> llvalue = "LLVMConstNot" external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd" external const_nsw_add : llvalue -> llvalue -> llvalue = "LLVMConstNSWAdd" +external const_nuw_add : llvalue -> llvalue -> llvalue = "LLVMConstNUWAdd" external const_fadd : llvalue -> llvalue -> llvalue = "LLVMConstFAdd" external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub" +external const_nsw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNSWSub" +external const_nuw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNUWSub" external const_fsub : llvalue -> llvalue -> llvalue = "LLVMConstFSub" external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul" +external const_nsw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNSWMul" +external const_nuw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNUWMul" external const_fmul : llvalue -> llvalue -> llvalue = "LLVMConstFMul" external const_udiv : llvalue -> llvalue -> llvalue = "LLVMConstUDiv" external const_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstSDiv" @@ -325,6 +393,10 @@ external const_extractvalue : llvalue -> int array -> llvalue = "llvm_const_extractvalue" external const_insertvalue : llvalue -> llvalue -> int array -> llvalue = "llvm_const_insertvalue" +external const_inline_asm : lltype -> string -> string -> bool -> bool -> + llvalue + = "llvm_const_inline_asm" +external block_address : llvalue -> llbasicblock -> llvalue = "LLVMBlockAddress" (*--... Operations on global variables, functions, and aliases (globals) ...--*) external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent" @@ -344,8 +416,14 @@ external set_global_constant : bool -> llvalue -> unit (*--... Operations on global variables .....................................--*) external declare_global : lltype -> string -> llmodule -> llvalue = "llvm_declare_global" +external declare_qualified_global : lltype -> string -> int -> llmodule -> + llvalue + = "llvm_declare_qualified_global" external define_global : string -> llvalue -> llmodule -> llvalue = "llvm_define_global" +external define_qualified_global : string -> llvalue -> int -> llmodule -> + llvalue + = "llvm_define_qualified_global" external lookup_global : string -> llmodule -> llvalue option = "llvm_lookup_global" external delete_global : llvalue -> unit = "llvm_delete_global" @@ -403,6 +481,10 @@ let rec fold_right_global_range f i e init = let fold_right_globals f m init = fold_right_global_range f (global_end m) (At_start m) init +(*--... Operations on aliases ..............................................--*) +external add_alias : llmodule -> lltype -> llvalue -> string -> llvalue + = "llvm_add_alias" + (*--... Operations on functions ............................................--*) external declare_function : string -> lltype -> llmodule -> llvalue = "llvm_declare_function" @@ -680,6 +762,17 @@ let position_before i = position_builder (Before i) let position_at_end bb = position_builder (At_end bb) +(*--... Metadata ...........................................................--*) +external set_current_debug_location : llbuilder -> llvalue -> unit + = "llvm_set_current_debug_location" +external clear_current_debug_location : llbuilder -> unit + = "llvm_clear_current_debug_location" +external current_debug_location : llbuilder -> llvalue option + = "llvm_current_debug_location" +external set_inst_debug_location : llbuilder -> llvalue -> unit + = "llvm_set_inst_debug_location" + + (*--... Terminators ........................................................--*) external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void" external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret" @@ -692,6 +785,10 @@ external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue = "llvm_build_switch" external add_case : llvalue -> llvalue -> llbasicblock -> unit = "llvm_add_case" +external build_indirect_br : llvalue -> int -> llbuilder -> llvalue + = "llvm_build_indirect_br" +external add_destination : llvalue -> llbasicblock -> unit + = "llvm_add_destination" external build_invoke : llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string -> llbuilder -> llvalue = "llvm_build_invoke_bc" "llvm_build_invoke_nat" @@ -703,14 +800,24 @@ external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_add" external build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_nsw_add" +external build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_add" external build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_fadd" external build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_sub" +external build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_sub" +external build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_sub" external build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_fsub" external build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_mul" +external build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_mul" +external build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_mul" external build_fmul : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_fmul" external build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue @@ -741,19 +848,20 @@ external build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_xor" external build_neg : llvalue -> string -> llbuilder -> llvalue = "llvm_build_neg" +external build_nsw_neg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_neg" +external build_nuw_neg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_neg" +external build_fneg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_fneg" external build_not : llvalue -> string -> llbuilder -> llvalue = "llvm_build_not" (*--... Memory .............................................................--*) -external build_malloc : lltype -> string -> llbuilder -> llvalue - = "llvm_build_malloc" -external build_array_malloc : lltype -> llvalue -> string -> llbuilder -> - llvalue = "llvm_build_array_malloc" external build_alloca : lltype -> string -> llbuilder -> llvalue = "llvm_build_alloca" external build_array_alloca : lltype -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_array_alloca" -external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free" external build_load : llvalue -> string -> llbuilder -> llvalue = "llvm_build_load" external build_store : llvalue -> llvalue -> llbuilder -> llvalue @@ -841,14 +949,6 @@ external build_is_not_null : llvalue -> string -> llbuilder -> llvalue external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_ptrdiff" -(*===-- Module providers --------------------------------------------------===*) - -module ModuleProvider = struct - external create : llmodule -> llmoduleprovider - = "LLVMCreateModuleProviderForExistingModule" - external dispose : llmoduleprovider -> unit = "llvm_dispose_module_provider" -end - (*===-- Memory buffers ----------------------------------------------------===*) @@ -865,7 +965,7 @@ module PassManager = struct type 'a t type any = [ `Module | `Function ] external create : unit -> [ `Module ] t = "llvm_passmanager_create" - external create_function : llmoduleprovider -> [ `Function ] t + external create_function : llmodule -> [ `Function ] t = "LLVMCreateFunctionPassManager" external run_module : llmodule -> [ `Module ] t -> bool = "llvm_passmanager_run_module" @@ -897,11 +997,14 @@ let rec string_of_lltype ty = | TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*" | TypeKind.Struct -> let s = "{ " ^ (concat2 ", " ( - Array.map string_of_lltype (element_types ty) + Array.map string_of_lltype (struct_element_types ty) )) ^ " }" in if is_packed ty then "<" ^ s ^ ">" else s + | TypeKind.Union -> "union { " ^ (concat2 ", " ( + Array.map string_of_lltype (union_element_types ty) + )) ^ " }" | TypeKind.Array -> "[" ^ (string_of_int (array_length ty)) ^ " x " ^ (string_of_lltype (element_type ty)) ^ "]" | TypeKind.Vector -> "<" ^ (string_of_int (vector_size ty)) ^ diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index bcdcb2c..4b0c06d 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -39,6 +39,9 @@ type lltypehandle This type covers a wide range of subclasses. *) type llvalue +(** Used to store users and usees of values. See the [llvm::Use] class. *) +type lluse + (** A basic block in LLVM IR. See the [llvm::BasicBlock] class. *) type llbasicblock @@ -46,10 +49,6 @@ type llbasicblock class. *) type llbuilder -(** Used to provide a module to JIT or interpreter. - See the [llvm::ModuleProvider] class. *) -type llmoduleprovider - (** Used to efficiently handle large buffers of read-only binary data. See the [llvm::MemoryBuffer] class. *) type llmemorybuffer @@ -73,6 +72,7 @@ module TypeKind : sig | Opaque | Vector | Metadata + | Union end (** The linkage of a global value, accessed with {!linkage} and @@ -139,11 +139,13 @@ module Attribute : sig | Optsize | Ssp | Sspreq + | Alignment | Nocapture | Noredzone | Noimplicitfloat | Naked | Inlinehint + | Stackalignment end (** The predicate for an integer comparison ([icmp]) instruction. @@ -220,6 +222,11 @@ external dispose_context : llcontext -> unit = "llvm_dispose_context" (** See the function [llvm::getGlobalContext]. *) external global_context : unit -> llcontext = "llvm_global_context" +(** [mdkind_id context name] returns the MDKind ID that corresponds to the + name [name] in the context [context]. See the function + [llvm::LLVMContext::getMDKindID]. *) +external mdkind_id : llcontext -> string -> int = "llvm_mdkind_id" + (** {6 Modules} *) @@ -268,6 +275,11 @@ external define_type_name : string -> lltype -> llmodule -> bool external delete_type_name : string -> llmodule -> unit = "llvm_delete_type_name" +(** [type_by_name m n] returns the type in the module [m] named [n], or [None] + if it does not exist. See the method [llvm::Module::getTypeByName]. *) +external type_by_name : llmodule -> string -> lltype option + = "llvm_type_by_name" + (** [dump_module m] prints the .ll representation of the module [m] to standard error. See the method [llvm::Module::dump]. *) external dump_module : llmodule -> unit = "llvm_dump_module" @@ -381,15 +393,29 @@ external struct_type : llcontext -> lltype array -> lltype external packed_struct_type : llcontext -> lltype array -> lltype = "llvm_packed_struct_type" -(** [element_types sty] returns the constituent types of the struct type [sty]. - See the method [llvm::StructType::getElementType]. *) -external element_types : lltype -> lltype array = "llvm_element_types" +(** [struct_element_types sty] returns the constituent types of the struct type + [sty]. See the method [llvm::StructType::getElementType]. *) +external struct_element_types : lltype -> lltype array + = "llvm_struct_element_types" (** [is_packed sty] returns [true] if the structure type [sty] is packed, [false] otherwise. See the method [llvm::StructType::isPacked]. *) external is_packed : lltype -> bool = "llvm_is_packed" +(** {7 Operations on union types} *) + +(** [union_type context tys] returns the union type in the context [context] + containing the types in the array [tys]. See the method + [llvm::UnionType::get] *) +external union_type : llcontext -> lltype array -> lltype = "llvm_union_type" + +(** [union_element_types uty] returns the constituent types of the union type + [uty]. See the method [llvm::UnionType::getElementType]. *) +external union_element_types : lltype -> lltype array + = "llvm_union_element_types" + + (** {7 Operations on pointer, vector, and array types} *) (** [array_type ty n] returns the array type containing [n] elements of type @@ -482,6 +508,50 @@ external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" error. See the method [llvm::Value::dump]. *) external dump_value : llvalue -> unit = "llvm_dump_value" +(** [replace_all_uses_with old new] replaces all uses of the value [old] + * with the value [new]. See the method [llvm::Value::replaceAllUsesWith]. *) +external replace_all_uses_with : llvalue -> llvalue -> unit + = "LLVMReplaceAllUsesWith" + + +(* {6 Uses} *) + +(** [use_begin v] returns the first position in the use list for the value [v]. + [use_begin] and [use_succ] can e used to iterate over the use list in order. + See the method [llvm::Value::use_begin]. *) +external use_begin : llvalue -> lluse option = "llvm_use_begin" + +(** [use_succ u] returns the use list position succeeding [u]. + See the method [llvm::use_value_iterator::operator++]. *) +external use_succ : lluse -> lluse option = "llvm_use_succ" + +(** [user u] returns the user of the use [u]. + See the method [llvm::Use::getUser]. *) +external user : lluse -> llvalue = "llvm_user" + +(** [used_value u] returns the usee of the use [u]. + See the method [llvm::Use::getUsedValue]. *) +external used_value : lluse -> llvalue = "llvm_used_value" + +(** [iter_uses f v] applies function [f] to each of the users of the value [v] + in order. Tail recursive. *) +val iter_uses : (lluse -> unit) -> llvalue -> unit + +(** [fold_left_uses f init v] is [f (... (f init u1) ...) uN] where + [u1,...,uN] are the users of the value [v]. Tail recursive. *) +val fold_left_uses : ('a -> lluse -> 'a) -> 'a -> llvalue -> 'a + +(** [fold_right_uses f v init] is [f u1 (... (f uN init) ...)] where + [u1,...,uN] are the users of the value [v]. Not tail recursive. *) +val fold_right_uses : (lluse -> 'a -> 'a) -> llvalue -> 'a -> 'a + + +(* {6 Users} *) + +(** [operand v i] returns the operand at index [i] for the value [v]. See the + method [llvm::User::getOperand]. *) +external operand : llvalue -> int -> llvalue = "llvm_operand" + (** {7 Operations on constants of (mostly) any type} *) @@ -497,6 +567,10 @@ external const_null : lltype -> llvalue = "LLVMConstNull" [ty]. See the method [llvm::Constant::getAllOnesValue]. *) external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes" +(** [const_pointer_null ty] returns the constant null (zero) pointer of the type + [ty]. See the method [llvm::ConstantPointerNull::get]. *) +external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull" + (** [undef ty] returns the undefined value of the type [ty]. See the method [llvm::UndefValue::get]. *) external undef : lltype -> llvalue = "LLVMGetUndef" @@ -510,6 +584,39 @@ external is_null : llvalue -> bool = "llvm_is_null" external is_undef : llvalue -> bool = "llvm_is_undef" +(** {7 Operations on instructions} *) + +(** [has_metadata i] returns whether or not the instruction [i] has any + metadata attached to it. See the function + [llvm::Instruction::hasMetadata]. *) +external has_metadata : llvalue -> bool = "llvm_has_metadata" + +(** [metadata i kind] optionally returns the metadata associated with the + kind [kind] in the instruction [i] See the function + [llvm::Instruction::getMetadata]. *) +external metadata : llvalue -> int -> llvalue option = "llvm_metadata" + +(** [set_metadata i kind md] sets the metadata [md] of kind [kind] in the + instruction [i]. See the function [llvm::Instruction::setMetadata]. *) +external set_metadata : llvalue -> int -> llvalue -> unit = "llvm_set_metadata" + +(** [clear_metadata i kind] clears the metadata of kind [kind] in the + instruction [i]. See the function [llvm::Instruction::setMetadata]. *) +external clear_metadata : llvalue -> int -> unit = "llvm_clear_metadata" + + +(** {7 Operations on metadata} *) + +(** [mdstring c s] returns the MDString of the string [s] in the context [c]. + See the method [llvm::MDNode::get]. *) +external mdstring : llcontext -> string -> llvalue = "llvm_mdstring" + +(** [mdnode c elts] returns the MDNode containing the values [elts] in the + context [c]. + See the method [llvm::MDNode::get]. *) +external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode" + + (** {7 Operations on scalar constants} *) (** [const_int ty i] returns the integer constant of type [ty] and value [i]. @@ -577,6 +684,10 @@ external const_packed_struct : llcontext -> llvalue array -> llvalue values [elts]. See the method [llvm::ConstantVector::get]. *) external const_vector : llvalue array -> llvalue = "llvm_const_vector" +(** [const_union ty v] returns the union constant of type [union_type tys] and + containing the value [v]. See the method [llvm::ConstantUnion::get]. *) +external const_union : lltype -> llvalue -> llvalue = "LLVMConstUnion" + (** {7 Constant expressions} *) @@ -596,6 +707,16 @@ external size_of : lltype -> llvalue = "LLVMSizeOf" See the method [llvm::ConstantExpr::getNeg]. *) external const_neg : llvalue -> llvalue = "LLVMConstNeg" +(** [const_nsw_neg c] returns the arithmetic negation of the constant [c] with + no signed wrapping. The result is undefined if the negation overflows. + See the method [llvm::ConstantExpr::getNSWNeg]. *) +external const_nsw_neg : llvalue -> llvalue = "LLVMConstNSWNeg" + +(** [const_nuw_neg c] returns the arithmetic negation of the constant [c] with + no unsigned wrapping. The result is undefined if the negation overflows. + See the method [llvm::ConstantExpr::getNUWNeg]. *) +external const_nuw_neg : llvalue -> llvalue = "LLVMConstNUWNeg" + (** [const_fneg c] returns the arithmetic negation of the constant float [c]. See the method [llvm::ConstantExpr::getFNeg]. *) external const_fneg : llvalue -> llvalue = "LLVMConstFNeg" @@ -613,6 +734,11 @@ external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd" See the method [llvm::ConstantExpr::getNSWAdd]. *) external const_nsw_add : llvalue -> llvalue -> llvalue = "LLVMConstNSWAdd" +(** [const_nuw_add c1 c2] returns the constant sum of two constants with no + unsigned wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWAdd]. *) +external const_nuw_add : llvalue -> llvalue -> llvalue = "LLVMConstNUWAdd" + (** [const_fadd c1 c2] returns the constant sum of two constant floats. See the method [llvm::ConstantExpr::getFAdd]. *) external const_fadd : llvalue -> llvalue -> llvalue = "LLVMConstFAdd" @@ -621,6 +747,16 @@ external const_fadd : llvalue -> llvalue -> llvalue = "LLVMConstFAdd" constants. See the method [llvm::ConstantExpr::getSub]. *) external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub" +(** [const_nsw_sub c1 c2] returns the constant difference of two constants with + no signed wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWSub]. *) +external const_nsw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNSWSub" + +(** [const_nuw_sub c1 c2] returns the constant difference of two constants with + no unsigned wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWSub]. *) +external const_nuw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNUWSub" + (** [const_fsub c1 c2] returns the constant difference, [c1 - c2], of two constant floats. See the method [llvm::ConstantExpr::getFSub]. *) external const_fsub : llvalue -> llvalue -> llvalue = "LLVMConstFSub" @@ -629,6 +765,16 @@ external const_fsub : llvalue -> llvalue -> llvalue = "LLVMConstFSub" See the method [llvm::ConstantExpr::getMul]. *) external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul" +(** [const_nsw_mul c1 c2] returns the constant product of two constants with + no signed wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWMul]. *) +external const_nsw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNSWMul" + +(** [const_nuw_mul c1 c2] returns the constant product of two constants with + no unsigned wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWMul]. *) +external const_nuw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNUWMul" + (** [const_fmul c1 c2] returns the constant product of two constants floats. See the method [llvm::ConstantExpr::getFMul]. *) external const_fmul : llvalue -> llvalue -> llvalue = "LLVMConstFMul" @@ -858,6 +1004,16 @@ external const_extractvalue : llvalue -> int array -> llvalue external const_insertvalue : llvalue -> llvalue -> int array -> llvalue = "llvm_const_insertvalue" +(** [const_inline_asm ty asm con side align] inserts a inline assembly string. + See the method [llvm::InlineAsm::get]. *) +external const_inline_asm : lltype -> string -> string -> bool -> bool -> + llvalue + = "llvm_const_inline_asm" + +(** [block_address f bb] returns the address of the basic block [bb] in the + function [f]. See the method [llvm::BasicBlock::get]. *) +external block_address : llvalue -> llbasicblock -> llvalue = "LLVMBlockAddress" + (** {7 Operations on global variables, functions, and aliases (globals)} *) @@ -907,19 +1063,36 @@ external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" (** {7 Operations on global variables} *) (** [declare_global ty name m] returns a new global variable of type [ty] and - with name [name] in module [m]. If such a global variable already exists, - it is returned. If the type of the existing global differs, then a bitcast - to [ty] is returned. *) + with name [name] in module [m] in the default address space (0). If such a + global variable already exists, it is returned. If the type of the existing + global differs, then a bitcast to [ty] is returned. *) external declare_global : lltype -> string -> llmodule -> llvalue = "llvm_declare_global" +(** [declare_qualified_global ty name addrspace m] returns a new global variable + of type [ty] and with name [name] in module [m] in the address space + [addrspace]. If such a global variable already exists, it is returned. If + the type of the existing global differs, then a bitcast to [ty] is + returned. *) +external declare_qualified_global : lltype -> string -> int -> llmodule -> + llvalue + = "llvm_declare_qualified_global" + (** [define_global name init m] returns a new global with name [name] and - initializer [init] in module [m]. If the named global already exists, it is - renamed. + initializer [init] in module [m] in the default address space (0). If the + named global already exists, it is renamed. See the constructor of [llvm::GlobalVariable]. *) external define_global : string -> llvalue -> llmodule -> llvalue = "llvm_define_global" +(** [define_qualified_global name init addrspace m] returns a new global with + name [name] and initializer [init] in module [m] in the address space + [addrspace]. If the named global already exists, it is renamed. + See the constructor of [llvm::GlobalVariable]. *) +external define_qualified_global : string -> llvalue -> int -> llmodule -> + llvalue + = "llvm_define_qualified_global" + (** [lookup_global name m] returns [Some g] if a global variable with name [name] exists in module [m]. If no such global exists, returns [None]. See the [llvm::GlobalVariable] constructor. *) @@ -1008,6 +1181,15 @@ external is_thread_local : llvalue -> bool = "llvm_is_thread_local" external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" +(** {7 Operations on aliases} *) + +(** [add_alias m t a n] inserts an alias in the module [m] with the type [t] and + the aliasee [a] with the name [n]. + See the constructor for [llvm::GlobalAlias]. *) +external add_alias : llmodule -> lltype -> llvalue -> string -> llvalue + = "llvm_add_alias" + + (** {7 Operations on functions} *) (** [declare_function name ty m] returns a new function of type [ty] and @@ -1397,6 +1579,30 @@ external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" external insert_into_builder : llvalue -> string -> llbuilder -> unit = "llvm_insert_into_builder" +(** {7 Metadata} *) + +(** [set_current_debug_location b md] sets the current debug location [md] in + the builder [b]. + See the method [llvm::IRBuilder::SetDebugLocation]. *) +external set_current_debug_location : llbuilder -> llvalue -> unit + = "llvm_set_current_debug_location" + +(** [clear_current_debug_location b] clears the current debug location in the + builder [b]. *) +external clear_current_debug_location : llbuilder -> unit + = "llvm_clear_current_debug_location" + +(** [current_debug_location b] returns the current debug location, or None + if none is currently set. + See the method [llvm::IRBuilder::GetDebugLocation]. *) +external current_debug_location : llbuilder -> llvalue option + = "llvm_current_debug_location" + +(** [set_inst_debug_location b i] sets the current debug location of the builder + [b] to the instruction [i]. + See the method [llvm::IRBuilder::SetInstDebugLocation]. *) +external set_inst_debug_location : llbuilder -> llvalue -> unit + = "llvm_set_inst_debug_location" (** {7 Terminators} *) @@ -1420,13 +1626,13 @@ external build_aggregate_ret : llvalue array -> llbuilder -> llvalue = "llvm_build_aggregate_ret" (** [build_br bb b] creates a - [b %bb] + [br %bb] instruction at the position specified by the instruction builder [b]. See the method [llvm::LLVMBuilder::CreateBr]. *) external build_br : llbasicblock -> llbuilder -> llvalue = "llvm_build_br" (** [build_cond_br cond tbb fbb b] creates a - [b %cond, %tbb, %fbb] + [br %cond, %tbb, %fbb] instruction at the position specified by the instruction builder [b]. See the method [llvm::LLVMBuilder::CreateCondBr]. *) external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder -> @@ -1446,6 +1652,20 @@ external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue external add_case : llvalue -> llvalue -> llbasicblock -> unit = "llvm_add_case" +(** [build_indirect_br addr count b] creates a + [indirectbr %addr] + instruction at the position specified by the instruction builder [b] with + space reserved for [count] destinations. + See the method [llvm::LLVMBuilder::CreateIndirectBr]. *) +external build_indirect_br : llvalue -> int -> llbuilder -> llvalue + = "llvm_build_indirect_br" + +(** [add_destination br bb] adds the basic block [bb] as a possible branch + location for the indirectbr instruction [br]. + See the method [llvm::IndirectBrInst::addDestination]. **) +external add_destination : llvalue -> llbasicblock -> unit + = "llvm_add_destination" + (** [build_invoke fn args tobb unwindbb name b] creates an [%name = invoke %fn(args) to %tobb unwind %unwindbb] instruction at the position specified by the instruction builder [b]. @@ -1476,13 +1696,20 @@ external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable" external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_add" -(** [build_nswadd x y name b] creates a +(** [build_nsw_add x y name b] creates a [%name = nsw add %x, %y] instruction at the position specified by the instruction builder [b]. See the method [llvm::LLVMBuilder::CreateNSWAdd]. *) external build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_nsw_add" +(** [build_nuw_add x y name b] creates a + [%name = nuw add %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNUWAdd]. *) +external build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_add" + (** [build_fadd x y name b] creates a [%name = fadd %x, %y] instruction at the position specified by the instruction builder [b]. @@ -1497,6 +1724,20 @@ external build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue external build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_sub" +(** [build_nsw_sub x y name b] creates a + [%name = nsw sub %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNSWSub]. *) +external build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_sub" + +(** [build_nuw_sub x y name b] creates a + [%name = nuw sub %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNUWSub]. *) +external build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_sub" + (** [build_fsub x y name b] creates a [%name = fsub %x, %y] instruction at the position specified by the instruction builder [b]. @@ -1511,6 +1752,20 @@ external build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue external build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_mul" +(** [build_nsw_mul x y name b] creates a + [%name = nsw mul %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNSWMul]. *) +external build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_mul" + +(** [build_nuw_mul x y name b] creates a + [%name = nuw mul %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNUWMul]. *) +external build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_mul" + (** [build_fmul x y name b] creates a [%name = fmul %x, %y] instruction at the position specified by the instruction builder [b]. @@ -1617,6 +1872,30 @@ external build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue external build_neg : llvalue -> string -> llbuilder -> llvalue = "llvm_build_neg" +(** [build_nsw_neg x name b] creates a + [%name = nsw sub 0, %x] + instruction at the position specified by the instruction builder [b]. + [-0.0] is used for floating point types to compute the correct sign. + See the method [llvm::LLVMBuilder::CreateNeg]. *) +external build_nsw_neg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_neg" + +(** [build_nuw_neg x name b] creates a + [%name = nuw sub 0, %x] + instruction at the position specified by the instruction builder [b]. + [-0.0] is used for floating point types to compute the correct sign. + See the method [llvm::LLVMBuilder::CreateNeg]. *) +external build_nuw_neg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_neg" + +(** [build_fneg x name b] creates a + [%name = fsub 0, %x] + instruction at the position specified by the instruction builder [b]. + [-0.0] is used for floating point types to compute the correct sign. + See the method [llvm::LLVMBuilder::CreateFNeg]. *) +external build_fneg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_fneg" + (** [build_xor x name b] creates a [%name = xor %x, -1] instruction at the position specified by the instruction builder [b]. @@ -1628,20 +1907,6 @@ external build_not : llvalue -> string -> llbuilder -> llvalue (** {7 Memory} *) -(** [build_malloc ty name b] creates a - [%name = malloc %ty] - instruction at the position specified by the instruction builder [b]. - See the method [llvm::LLVMBuilder::CreateAlloca]. *) -external build_malloc : lltype -> string -> llbuilder -> llvalue - = "llvm_build_malloc" - -(** [build_array_malloc ty n name b] creates a - [%name = malloc %ty, %n] - instruction at the position specified by the instruction builder [b]. - See the method [llvm::LLVMBuilder::CreateMalloc]. *) -external build_array_malloc : lltype -> llvalue -> string -> llbuilder -> - llvalue = "llvm_build_array_malloc" - (** [build_alloca ty name b] creates a [%name = alloca %ty] instruction at the position specified by the instruction builder [b]. @@ -1656,12 +1921,6 @@ external build_alloca : lltype -> string -> llbuilder -> llvalue external build_array_alloca : lltype -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_array_alloca" -(** [build_free v b] creates a - [free %v] - instruction at the position specified by the instruction builder [b]. - See the method [llvm::LLVMBuilder::CreateFree]. *) -external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free" - (** [build_load v name b] creates a [%name = load %v] instruction at the position specified by the instruction builder [b]. @@ -1938,20 +2197,6 @@ external build_is_not_null : llvalue -> string -> llbuilder -> llvalue external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_ptrdiff" -(** {6 Module providers} *) - -module ModuleProvider : sig - (** [create_module_provider m] encapsulates [m] in a module provider and takes - ownership of the module. See the constructor - [llvm::ExistingModuleProvider::ExistingModuleProvider]. *) - external create : llmodule -> llmoduleprovider - = "LLVMCreateModuleProviderForExistingModule" - - (** [dispose_module_provider mp] destroys the module provider [mp] as well as - the contained module. *) - external dispose : llmoduleprovider -> unit = "llvm_dispose_module_provider" -end - (** {6 Memory buffers} *) @@ -1983,12 +2228,12 @@ module PassManager : sig See the constructor of [llvm::PassManager]. *) external create : unit -> [ `Module ] t = "llvm_passmanager_create" - (** [PassManager.create_function mp] constructs a new function-by-function - pass pipeline over the module provider [mp]. It does not take ownership of - [mp]. This type of pipeline is suitable for code generation and JIT - compilation tasks. + (** [PassManager.create_function m] constructs a new function-by-function + pass pipeline over the module [m]. It does not take ownership of [m]. + This type of pipeline is suitable for code generation and JIT compilation + tasks. See the constructor of [llvm::FunctionPassManager]. *) - external create_function : llmoduleprovider -> [ `Function ] t + external create_function : llmodule -> [ `Function ] t = "LLVMCreateFunctionPassManager" (** [run_module m pm] initializes, executes on the module [m], and finalizes @@ -2018,7 +2263,7 @@ module PassManager : sig external finalize : [ `Function ] t -> bool = "llvm_passmanager_finalize" (** Frees the memory of a pass pipeline. For function pipelines, does not free - the module provider. + the module. See the destructor of [llvm::BasePassManager]. *) external dispose : [< any ] t -> unit = "llvm_passmanager_dispose" end diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 8fdcac5..d526a05 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -110,6 +110,13 @@ CAMLprim LLVMContextRef llvm_global_context(value Unit) { return LLVMGetGlobalContext(); } +/* llcontext -> string -> int */ +CAMLprim value llvm_mdkind_id(LLVMContextRef C, value Name) { + unsigned MDKindID = LLVMGetMDKindIDInContext(C, String_val(Name), + caml_string_length(Name)); + return Val_int(MDKindID); +} + /*===-- Modules -----------------------------------------------------------===*/ /* llcontext -> string -> llmodule */ @@ -157,6 +164,18 @@ CAMLprim value llvm_delete_type_name(value Name, LLVMModuleRef M) { return Val_unit; } +/* llmodule -> string -> lltype option */ +CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name) { + CAMLparam1(Name); + LLVMTypeRef T; + if ((T = LLVMGetTypeByName(M, String_val(Name)))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) T; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + /* llmodule -> unit */ CAMLprim value llvm_dump_module(LLVMModuleRef M) { LLVMDumpModule(M); @@ -283,7 +302,7 @@ CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C, } /* lltype -> lltype array */ -CAMLprim value llvm_element_types(LLVMTypeRef StructTy) { +CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) { value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0); LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys); return Tys; @@ -294,6 +313,21 @@ CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) { return Val_bool(LLVMIsPackedStruct(StructTy)); } +/*--... Operations on union types ..........................................--*/ + +/* llcontext -> lltype array -> lltype */ +CAMLprim LLVMTypeRef llvm_union_type(LLVMContextRef C, value ElementTypes) { + return LLVMUnionTypeInContext(C, (LLVMTypeRef *) ElementTypes, + Wosize_val(ElementTypes)); +} + +/* lltype -> lltype array */ +CAMLprim value llvm_union_element_types(LLVMTypeRef UnionTy) { + value Tys = alloc(LLVMCountUnionElementTypes(UnionTy), 0); + LLVMGetUnionElementTypes(UnionTy, (LLVMTypeRef *) Tys); + return Tys; +} + /*--... Operations on array, pointer, and vector types .....................--*/ /* lltype -> int -> lltype */ @@ -406,6 +440,13 @@ CAMLprim value llvm_dump_value(LLVMValueRef Val) { return Val_unit; } +/*--... Operations on users ................................................--*/ + +/* llvalue -> int -> llvalue */ +CAMLprim LLVMValueRef llvm_operand(LLVMValueRef V, value I) { + return LLVMGetOperand(V, Int_val(I)); +} + /*--... Operations on constants of (mostly) any type .......................--*/ /* llvalue -> bool */ @@ -423,6 +464,52 @@ CAMLprim value llvm_is_undef(LLVMValueRef Val) { return Val_bool(LLVMIsUndef(Val)); } +/*--... Operations on instructions .........................................--*/ + +/* llvalue -> bool */ +CAMLprim value llvm_has_metadata(LLVMValueRef Val) { + return Val_bool(LLVMHasMetadata(Val)); +} + +/* llvalue -> int -> llvalue option */ +CAMLprim value llvm_metadata(LLVMValueRef Val, value MDKindID) { + CAMLparam1(MDKindID); + LLVMValueRef MD; + if ((MD = LLVMGetMetadata(Val, Int_val(MDKindID)))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) MD; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* llvalue -> int -> llvalue -> unit */ +CAMLprim value llvm_set_metadata(LLVMValueRef Val, value MDKindID, + LLVMValueRef MD) { + LLVMSetMetadata(Val, Int_val(MDKindID), MD); + return Val_unit; +} + +/* llvalue -> int -> unit */ +CAMLprim value llvm_clear_metadata(LLVMValueRef Val, value MDKindID) { + LLVMSetMetadata(Val, Int_val(MDKindID), NULL); + return Val_unit; +} + + +/*--... Operations on metadata .............................................--*/ + +/* llcontext -> string -> llvalue */ +CAMLprim LLVMValueRef llvm_mdstring(LLVMContextRef C, value S) { + return LLVMMDStringInContext(C, String_val(S), caml_string_length(S)); +} + +/* llcontext -> llvalue array -> llvalue */ +CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) { + return LLVMMDNodeInContext(C, (LLVMValueRef*) Op_val(ElementVals), + Wosize_val(ElementVals)); +} + /*--... Operations on scalar constants .....................................--*/ /* lltype -> int -> llvalue */ @@ -561,6 +648,14 @@ CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate, CAMLreturnT(LLVMValueRef, result); } +/* lltype -> string -> string -> bool -> bool -> llvalue */ +CAMLprim LLVMValueRef llvm_const_inline_asm(LLVMTypeRef Ty, value Asm, + value Constraints, value HasSideEffects, + value IsAlignStack) { + return LLVMConstInlineAsm(Ty, String_val(Asm), String_val(Constraints), + Bool_val(HasSideEffects), Bool_val(IsAlignStack)); +} + /*--... Operations on global variables, functions, and aliases (globals) ...--*/ /* llvalue -> bool */ @@ -612,6 +707,42 @@ CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) { return Val_unit; } +/*--... Operations on uses .................................................--*/ + +/* llvalue -> lluse option */ +CAMLprim value llvm_use_begin(LLVMValueRef Val) { + CAMLparam0(); + LLVMUseRef First; + if ((First = LLVMGetFirstUse(Val))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) First; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* lluse -> lluse option */ +CAMLprim value llvm_use_succ(LLVMUseRef U) { + CAMLparam0(); + LLVMUseRef Next; + if ((Next = LLVMGetNextUse(U))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) Next; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* lluse -> llvalue */ +CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) { + return LLVMGetUser(UR); +} + +/* lluse -> llvalue */ +CAMLprim LLVMValueRef llvm_used_value(LLVMUseRef UR) { + return LLVMGetUsedValue(UR); +} + /*--... Operations on global variables .....................................--*/ DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef, @@ -629,6 +760,20 @@ CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name, return LLVMAddGlobal(M, Ty, String_val(Name)); } +/* lltype -> string -> int -> llmodule -> llvalue */ +CAMLprim LLVMValueRef llvm_declare_qualified_global(LLVMTypeRef Ty, value Name, + value AddressSpace, + LLVMModuleRef M) { + LLVMValueRef GlobalVar; + if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) { + if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty) + return LLVMConstBitCast(GlobalVar, + LLVMPointerType(Ty, Int_val(AddressSpace))); + return GlobalVar; + } + return LLVMAddGlobal(M, Ty, String_val(Name)); +} + /* string -> llmodule -> llvalue option */ CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) { CAMLparam1(Name); @@ -650,6 +795,19 @@ CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer, return GlobalVar; } +/* string -> llvalue -> int -> llmodule -> llvalue */ +CAMLprim LLVMValueRef llvm_define_qualified_global(value Name, + LLVMValueRef Initializer, + value AddressSpace, + LLVMModuleRef M) { + LLVMValueRef GlobalVar = LLVMAddGlobalInAddressSpace(M, + LLVMTypeOf(Initializer), + String_val(Name), + Int_val(AddressSpace)); + LLVMSetInitializer(GlobalVar, Initializer); + return GlobalVar; +} + /* llvalue -> unit */ CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) { LLVMDeleteGlobal(GlobalVar); @@ -692,6 +850,13 @@ CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) { return Val_unit; } +/*--... Operations on aliases ..............................................--*/ + +CAMLprim LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty, + LLVMValueRef Aliasee, value Name) { + return LLVMAddAlias(M, Ty, Aliasee, String_val(Name)); +} + /*--... Operations on functions ............................................--*/ DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef, @@ -978,7 +1143,7 @@ CAMLprim value llvm_position_builder(value Pos, value B) { } /* llbuilder -> llbasicblock */ -CAMLprim LLVMBasicBlockRef llvm_insertion_block(LLVMBuilderRef B) { +CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) { LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B)); if (!InsertBlock) raise_not_found(); @@ -986,12 +1151,44 @@ CAMLprim LLVMBasicBlockRef llvm_insertion_block(LLVMBuilderRef B) { } /* llvalue -> string -> llbuilder -> unit */ -CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, - LLVMBuilderRef B) { - LLVMInsertIntoBuilderWithName(B, I, String_val(Name)); +CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) { + LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name)); + return Val_unit; +} + +/*--... Metadata ...........................................................--*/ + +/* llbuilder -> llvalue -> unit */ +CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) { + LLVMSetCurrentDebugLocation(Builder_val(B), V); return Val_unit; } +/* llbuilder -> unit */ +CAMLprim value llvm_clear_current_debug_location(value B) { + LLVMSetCurrentDebugLocation(Builder_val(B), NULL); + return Val_unit; +} + +/* llbuilder -> llvalue option */ +CAMLprim value llvm_current_debug_location(value B) { + CAMLparam0(); + LLVMValueRef L; + if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) L; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* llbuilder -> llvalue -> unit */ +CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) { + LLVMSetInstDebugLocation(Builder_val(B), V); + return Val_unit; +} + + /*--... Terminators ........................................................--*/ /* llbuilder -> llvalue */ @@ -1031,13 +1228,27 @@ CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of, return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount)); } -CAMLprim value llvm_add_case(LLVMValueRef Switch, - LLVMValueRef OnVal, +/* llvalue -> llvalue -> llbasicblock -> unit */ +CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal, LLVMBasicBlockRef Dest) { LLVMAddCase(Switch, OnVal, Dest); return Val_unit; } +/* llvalue -> llbasicblock -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr, + value EstimatedDests, + value B) { + return LLVMBuildIndirectBr(Builder_val(B), Addr, EstimatedDests); +} + +/* llvalue -> llvalue -> llbasicblock -> unit */ +CAMLprim value llvm_add_destination(LLVMValueRef IndirectBr, + LLVMBasicBlockRef Dest) { + LLVMAddDestination(IndirectBr, Dest); + return Val_unit; +} + /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string -> llbuilder -> llvalue */ CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args, @@ -1082,6 +1293,12 @@ CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS, } /* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nuw_add(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNUWAdd(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS, value Name, value B) { return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name)); @@ -1094,6 +1311,18 @@ CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS, } /* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nsw_sub(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNSWSub(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nuw_sub(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNUWSub(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS, value Name, value B) { return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name)); @@ -1106,6 +1335,18 @@ CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS, } /* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nsw_mul(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNSWMul(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nuw_mul(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNUWMul(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS, value Name, value B) { return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name)); @@ -1196,25 +1437,31 @@ CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X, } /* llvalue -> string -> llbuilder -> llvalue */ -CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X, - value Name, value B) { - return LLVMBuildNot(Builder_val(B), X, String_val(Name)); +CAMLprim LLVMValueRef llvm_build_nsw_neg(LLVMValueRef X, + value Name, value B) { + return LLVMBuildNSWNeg(Builder_val(B), X, String_val(Name)); } -/*--... Memory .............................................................--*/ +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nuw_neg(LLVMValueRef X, + value Name, value B) { + return LLVMBuildNUWNeg(Builder_val(B), X, String_val(Name)); +} -/* lltype -> string -> llbuilder -> llvalue */ -CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, - value Name, value B) { - return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name)); +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fneg(LLVMValueRef X, + value Name, value B) { + return LLVMBuildFNeg(Builder_val(B), X, String_val(Name)); } -/* lltype -> llvalue -> string -> llbuilder -> llvalue */ -CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty, LLVMValueRef Size, - value Name, value B) { - return LLVMBuildArrayMalloc(Builder_val(B), Ty, Size, String_val(Name)); +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X, + value Name, value B) { + return LLVMBuildNot(Builder_val(B), X, String_val(Name)); } +/*--... Memory .............................................................--*/ + /* lltype -> string -> llbuilder -> llvalue */ CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty, value Name, value B) { @@ -1227,11 +1474,6 @@ CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size, return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name)); } -/* llvalue -> llbuilder -> llvalue */ -CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef Pointer, value B) { - return LLVMBuildFree(Builder_val(B), Pointer); -} - /* llvalue -> string -> llbuilder -> llvalue */ CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer, value Name, value B) { @@ -1510,14 +1752,6 @@ CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS, return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name)); } -/*===-- Module Providers --------------------------------------------------===*/ - -/* llmoduleprovider -> unit */ -CAMLprim value llvm_dispose_module_provider(LLVMModuleProviderRef MP) { - LLVMDisposeModuleProvider(MP); - return Val_unit; -} - /*===-- Memory buffers ----------------------------------------------------===*/ diff --git a/bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml b/bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml index b4563b7..5699152 100644 --- a/bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml +++ b/bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml @@ -10,9 +10,38 @@ external add_constant_propagation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit = "llvm_add_constant_propagation" -external add_instruction_combining : [<Llvm.PassManager.any] Llvm.PassManager.t - -> unit - = "llvm_add_instruction_combining" +external add_sccp : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_sccp" +external add_dead_store_elimination : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_dead_store_elimination" +external add_aggressive_dce : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_aggressive_dce" +external +add_scalar_repl_aggregation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_scalar_repl_aggregation" +external add_ind_var_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_ind_var_simplification" +external +add_instruction_combination : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_instruction_combination" +external add_licm : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_licm" +external add_loop_unswitch : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_unswitch" +external add_loop_unroll : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_unroll" +external add_loop_rotation : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_rotation" +external add_loop_index_split : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_index_split" external add_memory_to_register_promotion : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit @@ -21,12 +50,26 @@ external add_memory_to_register_demotion : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit = "llvm_add_memory_to_register_demotion" -external add_reassociation : [<Llvm.PassManager.any] Llvm.PassManager.t - -> unit +external add_reassociation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit = "llvm_add_reassociation" -external add_gvn : [<Llvm.PassManager.any] Llvm.PassManager.t - -> unit - = "llvm_add_gvn" +external add_jump_threading : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_jump_threading" external add_cfg_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit = "llvm_add_cfg_simplification" +external +add_tail_call_elimination : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_tail_call_elimination" +external add_gvn : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_gvn" +external add_memcpy_opt : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_memcpy_opt" +external add_loop_deletion : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_deletion" +external +add_lib_call_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_lib_call_simplification" diff --git a/bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli b/bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli index 6fcce04..9f95fbc 100644 --- a/bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli +++ b/bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli @@ -17,10 +17,59 @@ external add_constant_propagation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit = "llvm_add_constant_propagation" +(** See the [llvm::createSCCPPass] function. *) +external add_sccp : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_sccp" + +(** See [llvm::createDeadStoreEliminationPass] function. *) +external add_dead_store_elimination : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_dead_store_elimination" + +(** See The [llvm::createAggressiveDCEPass] function. *) +external add_aggressive_dce : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_aggressive_dce" + +(** See the [llvm::createScalarReplAggregatesPass] function. *) +external +add_scalar_repl_aggregation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_scalar_repl_aggregation" + +(** See the [llvm::createIndVarSimplifyPass] function. *) +external add_ind_var_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_ind_var_simplification" + (** See the [llvm::createInstructionCombiningPass] function. *) -external add_instruction_combining : [<Llvm.PassManager.any] Llvm.PassManager.t - -> unit - = "llvm_add_instruction_combining" +external +add_instruction_combination : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_instruction_combination" + +(** See the [llvm::createLICMPass] function. *) +external add_licm : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_licm" + +(** See the [llvm::createLoopUnswitchPass] function. *) +external add_loop_unswitch : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_unswitch" + +(** See the [llvm::createLoopUnrollPass] function. *) +external add_loop_unroll : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_unroll" + +(** See the [llvm::createLoopRotatePass] function. *) +external add_loop_rotation : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_rotation" + +(** See the [llvm::createLoopIndexSplitPass] function. *) +external add_loop_index_split : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_index_split" (** See the [llvm::createPromoteMemoryToRegisterPass] function. *) external @@ -35,16 +84,40 @@ add_memory_to_register_demotion : [<Llvm.PassManager.any] Llvm.PassManager.t = "llvm_add_memory_to_register_demotion" (** See the [llvm::createReassociatePass] function. *) -external add_reassociation : [<Llvm.PassManager.any] Llvm.PassManager.t - -> unit +external add_reassociation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit = "llvm_add_reassociation" -(** See the [llvm::createGVNPass] function. *) -external add_gvn : [<Llvm.PassManager.any] Llvm.PassManager.t - -> unit - = "llvm_add_gvn" +(** See the [llvm::createJumpThreadingPass] function. *) +external add_jump_threading : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_jump_threading" (** See the [llvm::createCFGSimplificationPass] function. *) external add_cfg_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit = "llvm_add_cfg_simplification" + +(** See the [llvm::createTailCallEliminationPass] function. *) +external +add_tail_call_elimination : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_tail_call_elimination" + +(** See the [llvm::createGVNPass] function. *) +external add_gvn : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_gvn" + +(** See the [llvm::createMemCpyOptPass] function. *) +external add_memcpy_opt : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_memcpy_opt" + +(** See the [llvm::createLoopDeletionPass] function. *) +external add_loop_deletion : [<Llvm.PassManager.any] Llvm.PassManager.t + -> unit + = "llvm_add_loop_deletion" + +(** See the [llvm::createSimplifyLibCallsPass] function. *) +external +add_lib_call_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit + = "llvm_add_lib_call_simplification" diff --git a/bindings/ocaml/transforms/scalar/scalar_opts_ocaml.c b/bindings/ocaml/transforms/scalar/scalar_opts_ocaml.c index 87c1060..c20bdde 100644 --- a/bindings/ocaml/transforms/scalar/scalar_opts_ocaml.c +++ b/bindings/ocaml/transforms/scalar/scalar_opts_ocaml.c @@ -26,12 +26,72 @@ CAMLprim value llvm_add_constant_propagation(LLVMPassManagerRef PM) { } /* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ -CAMLprim value llvm_add_instruction_combining(LLVMPassManagerRef PM) { +CAMLprim value llvm_add_sccp(LLVMPassManagerRef PM) { + LLVMAddSCCPPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_dead_store_elimination(LLVMPassManagerRef PM) { + LLVMAddDeadStoreEliminationPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_aggressive_dce(LLVMPassManagerRef PM) { + LLVMAddAggressiveDCEPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_scalar_repl_aggregation(LLVMPassManagerRef PM) { + LLVMAddScalarReplAggregatesPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_ind_var_simplification(LLVMPassManagerRef PM) { + LLVMAddIndVarSimplifyPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_instruction_combination(LLVMPassManagerRef PM) { LLVMAddInstructionCombiningPass(PM); return Val_unit; } /* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_licm(LLVMPassManagerRef PM) { + LLVMAddLICMPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_loop_unswitch(LLVMPassManagerRef PM) { + LLVMAddLoopUnrollPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_loop_unroll(LLVMPassManagerRef PM) { + LLVMAddLoopUnrollPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_loop_rotation(LLVMPassManagerRef PM) { + LLVMAddLoopRotatePass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_loop_index_split(LLVMPassManagerRef PM) { + LLVMAddLoopIndexSplitPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ CAMLprim value llvm_add_memory_to_register_promotion(LLVMPassManagerRef PM) { LLVMAddPromoteMemoryToRegisterPass(PM); return Val_unit; @@ -50,8 +110,8 @@ CAMLprim value llvm_add_reassociation(LLVMPassManagerRef PM) { } /* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ -CAMLprim value llvm_add_gvn(LLVMPassManagerRef PM) { - LLVMAddGVNPass(PM); +CAMLprim value llvm_add_jump_threading(LLVMPassManagerRef PM) { + LLVMAddJumpThreadingPass(PM); return Val_unit; } @@ -60,3 +120,33 @@ CAMLprim value llvm_add_cfg_simplification(LLVMPassManagerRef PM) { LLVMAddCFGSimplificationPass(PM); return Val_unit; } + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_tail_call_elimination(LLVMPassManagerRef PM) { + LLVMAddTailCallEliminationPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_gvn(LLVMPassManagerRef PM) { + LLVMAddGVNPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_memcpy_opt(LLVMPassManagerRef PM) { + LLVMAddMemCpyOptPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_loop_deletion(LLVMPassManagerRef PM) { + LLVMAddLoopDeletionPass(PM); + return Val_unit; +} + +/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_lib_call_simplification(LLVMPassManagerRef PM) { + LLVMAddSimplifyLibCallsPass(PM); + return Val_unit; +} |