diff options
author | Roman Divacky <rdivacky@FreeBSD.org> | 2010-03-03 17:27:15 +0000 |
---|---|---|
committer | Roman Divacky <rdivacky@FreeBSD.org> | 2010-03-03 17:27:15 +0000 |
commit | 67a71b3184ce20a901e874d0ee25e01397dd87ef (patch) | |
tree | 836a05cff50ca46176117b86029f061fa4db54f0 /bindings | |
parent | 6fe5c7aa327e188b7176daa5595bbf075a6b94df (diff) |
Notes
Diffstat (limited to 'bindings')
-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/executionengine/executionengine_ocaml.c | 43 | ||||
-rw-r--r-- | bindings/ocaml/executionengine/llvm_executionengine.ml | 12 | ||||
-rw-r--r-- | bindings/ocaml/executionengine/llvm_executionengine.mli | 54 | ||||
-rw-r--r-- | bindings/ocaml/llvm/llvm.ml | 135 | ||||
-rw-r--r-- | bindings/ocaml/llvm/llvm.mli | 347 | ||||
-rw-r--r-- | bindings/ocaml/llvm/llvm_ocaml.c | 294 |
9 files changed, 732 insertions, 181 deletions
diff --git a/bindings/ocaml/bitreader/bitreader_ocaml.c b/bindings/ocaml/bitreader/bitreader_ocaml.c index 5fd9f854d9da2..ef72ce213d8b9 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 88587cbe1ef94..8b9d01d8fb010 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 5648b35fee223..5e2240974af44 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/executionengine/executionengine_ocaml.c b/bindings/ocaml/executionengine/executionengine_ocaml.c index 072d583bf8fb6..1d3e57a705b82 100644 --- a/bindings/ocaml/executionengine/executionengine_ocaml.c +++ b/bindings/ocaml/executionengine/executionengine_ocaml.c @@ -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_mp(LLVMModuleRef M, LLVMExecutionEngineRef EE) { + LLVMAddModule(EE, M); return Val_unit; } -/* llmoduleprovider -> ExecutionEngine.t -> llmodule */ -CAMLprim LLVMModuleRef llvm_ee_remove_mp(LLVMModuleProviderRef MP, +/* llmodule -> ExecutionEngine.t -> llmodule */ +CAMLprim LLVMModuleRef llvm_ee_remove_mp(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 c9e8f18b22409..95faa58cc548a 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.ml +++ b/bindings/ocaml/executionengine/llvm_executionengine.ml @@ -56,19 +56,17 @@ 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 + external add_module: Llvm.llmodule -> t -> unit = "llvm_ee_add_mp" - external remove_module_provider: Llvm.llmoduleprovider -> t -> Llvm.llmodule + external remove_module: Llvm.llmodule -> t -> Llvm.llmodule = "llvm_ee_remove_mp" external find_function: string -> t -> Llvm.llvalue option = "llvm_ee_find_function" diff --git a/bindings/ocaml/executionengine/llvm_executionengine.mli b/bindings/ocaml/executionengine/llvm_executionengine.mli index 6c2fdfb7868c4..ac6665b2bc85a 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.mli +++ b/bindings/ocaml/executionengine/llvm_executionengine.mli @@ -85,48 +85,38 @@ 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 + val create: Llvm.llmodule -> t - (** [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 + val create_interpreter: Llvm.llmodule -> t - (** [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 - + val create_jit : Llvm.llmodule -> int -> 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 + (** [add_module m ee] adds the module [m] to the execution engine [ee]. *) + val add_module: Llvm.llmodule -> 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 + (** [remove_module m ee] removes the module [m] from the execution engine + [ee], disposing of [m] and the module referenced by [mp]. Raises + [Error msg] if an error occurs. *) + val remove_module: Llvm.llmodule -> t -> Llvm.llmodule (** [find_function n ee] finds the function named [n] defined in any of the modules owned by the execution engine [ee]. Returns [None] if the function diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 7e4acbff47619..407c1fc6c63f8 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 @@ -147,6 +148,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 +165,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 +202,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 +239,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 +315,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 +391,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 +414,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 +479,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 +760,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 +783,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 +798,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 +846,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 +947,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 +963,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 +995,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 4f28ae687564e..aa5ea760c46de 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 @@ -220,6 +220,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 +273,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 +391,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 +506,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 +565,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 +582,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 +682,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 +705,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 +732,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 +745,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 +763,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 +1002,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 +1061,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 +1179,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 +1577,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} *) @@ -1446,6 +1650,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]. @@ -1483,6 +1701,13 @@ external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 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 +1722,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 +1750,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 +1870,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 +1905,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 +1919,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 +2195,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 +2226,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 +2261,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 86492d7fbbeb6..d526a05a51090 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 */ @@ -1038,6 +1235,20 @@ CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal, 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 ----------------------------------------------------===*/ |