diff options
author | Erick Tryzelaar <idadesub@users.sourceforge.net> | 2010-02-28 09:45:59 +0000 |
---|---|---|
committer | Erick Tryzelaar <idadesub@users.sourceforge.net> | 2010-02-28 09:45:59 +0000 |
commit | 46c80e0c5653e11ada7cebcb46f9a8f7df758e41 (patch) | |
tree | f3225fd81e03d98416d92c08cbce02e04100596f /bindings/ocaml | |
parent | e0d2753f2b43ab595e341e45dbb874a330bd8d5f (diff) | |
download | external_llvm-46c80e0c5653e11ada7cebcb46f9a8f7df758e41.zip external_llvm-46c80e0c5653e11ada7cebcb46f9a8f7df758e41.tar.gz external_llvm-46c80e0c5653e11ada7cebcb46f9a8f7df758e41.tar.bz2 |
Add metadata functions to llvm-c and ocaml.
git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@97375 91177308-0d34-0410-b5e6-96231b3b80d8
Diffstat (limited to 'bindings/ocaml')
-rw-r--r-- | bindings/ocaml/llvm/llvm.ml | 22 | ||||
-rw-r--r-- | bindings/ocaml/llvm/llvm.mli | 62 | ||||
-rw-r--r-- | bindings/ocaml/llvm/llvm_ocaml.c | 86 |
3 files changed, 170 insertions, 0 deletions
diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 0c2cebd..837f6a3 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -148,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" @@ -245,6 +246,16 @@ 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 @@ -695,6 +706,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" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 98ba05f..5a15642 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -221,6 +221,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} *) @@ -525,6 +530,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]. @@ -1451,6 +1489,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} *) diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 2b6eb56..e56af1e 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 */ @@ -438,6 +445,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 */ @@ -1006,6 +1059,39 @@ CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) { 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 */ |