diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 0c2cebd6a28..837f6a3b745 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 98ba05f2081..5a156428bf5 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 2b6eb56d981..e56af1e7530 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 */ diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h index 8d4fca1981b..1a29463e146 100644 --- a/include/llvm-c/Core.h +++ b/include/llvm-c/Core.h @@ -282,13 +282,19 @@ typedef enum { void LLVMDisposeMessage(char *Message); -/*===-- Modules -----------------------------------------------------------===*/ +/*===-- Contexts ----------------------------------------------------------===*/ /* Create and destroy contexts. */ LLVMContextRef LLVMContextCreate(void); LLVMContextRef LLVMGetGlobalContext(void); void LLVMContextDispose(LLVMContextRef C); +unsigned LLVMGetMDKindIDInContext(LLVMContextRef C, const char* Name, + unsigned SLen); +unsigned LLVMGetMDKindID(const char* Name, unsigned SLen); + +/*===-- Modules -----------------------------------------------------------===*/ + /* Create and destroy modules. */ /** See llvm::Module::Module. */ LLVMModuleRef LLVMModuleCreateWithName(const char *ModuleID); @@ -497,6 +503,9 @@ const char *LLVMGetValueName(LLVMValueRef Val); void LLVMSetValueName(LLVMValueRef Val, const char *Name); void LLVMDumpValue(LLVMValueRef Val); void LLVMReplaceAllUsesWith(LLVMValueRef OldVal, LLVMValueRef NewVal); +int LLVMHasMetadata(LLVMValueRef Val); +LLVMValueRef LLVMGetMetadata(LLVMValueRef Val, unsigned KindID); +void LLVMSetMetadata(LLVMValueRef Val, unsigned KindID, LLVMValueRef Node); /* Conversion functions. Return the input value if it is an instance of the specified class, otherwise NULL. See llvm::dyn_cast_or_null<>. */ @@ -522,6 +531,14 @@ LLVMBool LLVMIsNull(LLVMValueRef Val); LLVMBool LLVMIsUndef(LLVMValueRef Val); LLVMValueRef LLVMConstPointerNull(LLVMTypeRef Ty); +/* Operations on metadata */ +LLVMValueRef LLVMMDStringInContext(LLVMContextRef C, const char *Str, + unsigned SLen); +LLVMValueRef LLVMMDString(const char *Str, unsigned SLen); +LLVMValueRef LLVMMDNodeInContext(LLVMContextRef C, LLVMValueRef *Vals, + unsigned Count); +LLVMValueRef LLVMMDNode(LLVMValueRef *Vals, unsigned Count); + /* Operations on scalar constants */ LLVMValueRef LLVMConstInt(LLVMTypeRef IntTy, unsigned long long N, LLVMBool SignExtend); @@ -773,6 +790,11 @@ void LLVMInsertIntoBuilderWithName(LLVMBuilderRef Builder, LLVMValueRef Instr, const char *Name); void LLVMDisposeBuilder(LLVMBuilderRef Builder); +/* Metadata */ +void LLVMSetCurrentDebugLocation(LLVMBuilderRef Builder, LLVMValueRef L); +LLVMValueRef LLVMGetCurrentDebugLocation(LLVMBuilderRef Builder); +void LLVMSetInstDebugLocation(LLVMBuilderRef Builder, LLVMValueRef Inst); + /* Terminators */ LLVMValueRef LLVMBuildRetVoid(LLVMBuilderRef); LLVMValueRef LLVMBuildRet(LLVMBuilderRef, LLVMValueRef V); diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp index 57705daa101..9f1ee17c54b 100644 --- a/lib/VMCore/Core.cpp +++ b/lib/VMCore/Core.cpp @@ -55,6 +55,15 @@ void LLVMContextDispose(LLVMContextRef C) { delete unwrap(C); } +unsigned LLVMGetMDKindIDInContext(LLVMContextRef C, const char* Name, + unsigned SLen) { + return unwrap(C)->getMDKindID(StringRef(Name, SLen)); +} + +unsigned LLVMGetMDKindID(const char* Name, unsigned SLen) { + return LLVMGetMDKindIDInContext(LLVMGetGlobalContext(), Name, SLen); +} + /*===-- Operations on modules ---------------------------------------------===*/ @@ -425,6 +434,18 @@ void LLVMReplaceAllUsesWith(LLVMValueRef OldVal, LLVMValueRef NewVal) { unwrap(OldVal)->replaceAllUsesWith(unwrap(NewVal)); } +int LLVMHasMetadata(LLVMValueRef Inst) { + return unwrap(Inst)->hasMetadata(); +} + +LLVMValueRef LLVMGetMetadata(LLVMValueRef Inst, unsigned KindID) { + return wrap(unwrap(Inst)->getMetadata(KindID)); +} + +void LLVMSetMetadata(LLVMValueRef Inst, unsigned KindID, LLVMValueRef MD) { + unwrap(Inst)->setMetadata(KindID, MD? unwrap(MD) : NULL); +} + /*--.. Conversion functions ................................................--*/ #define LLVM_DEFINE_VALUE_CAST(name) \ @@ -493,6 +514,26 @@ LLVMValueRef LLVMConstPointerNull(LLVMTypeRef Ty) { wrap(ConstantPointerNull::get(unwrap(Ty))); } +/*--.. Operations on metadata nodes ........................................--*/ + +LLVMValueRef LLVMMDStringInContext(LLVMContextRef C, const char *Str, + unsigned SLen) { + return wrap(MDString::get(*unwrap(C), StringRef(Str, SLen))); +} + +LLVMValueRef LLVMMDString(const char *Str, unsigned SLen) { + return LLVMMDStringInContext(LLVMGetGlobalContext(), Str, SLen); +} + +LLVMValueRef LLVMMDNodeInContext(LLVMContextRef C, LLVMValueRef *Vals, + unsigned Count) { + return wrap(MDNode::get(*unwrap(C), unwrap(Vals, Count), Count)); +} + +LLVMValueRef LLVMMDNode(LLVMValueRef *Vals, unsigned Count) { + return LLVMMDNodeInContext(LLVMGetGlobalContext(), Vals, Count); +} + /*--.. Operations on scalar constants ......................................--*/ LLVMValueRef LLVMConstInt(LLVMTypeRef IntTy, unsigned long long N, @@ -1611,6 +1652,21 @@ void LLVMDisposeBuilder(LLVMBuilderRef Builder) { delete unwrap(Builder); } +/*--.. Metadata builders ...................................................--*/ + +void LLVMSetCurrentDebugLocation(LLVMBuilderRef Builder, LLVMValueRef L) { + unwrap(Builder)->SetCurrentDebugLocation(L? unwrap(L) : NULL); +} + +LLVMValueRef LLVMGetCurrentDebugLocation(LLVMBuilderRef Builder) { + return wrap(unwrap(Builder)->getCurrentDebugLocation()); +} + +void LLVMSetInstDebugLocation(LLVMBuilderRef Builder, LLVMValueRef Inst) { + unwrap(Builder)->SetInstDebugLocation(unwrap(Inst)); +} + + /*--.. Instruction builders ................................................--*/ LLVMValueRef LLVMBuildRetVoid(LLVMBuilderRef B) { diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index 48c1a9570a3..57a842583f6 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -1089,6 +1089,46 @@ let test_builder () = ignore (build_insertelement vec1 p1 p2 "build_insertelement" atentry); ignore (build_shufflevector vec1 vec2 t3 "build_shufflevector" atentry); end; + + group "metadata"; begin + (* RUN: grep {%metadata = add i32 %P1, %P2, !test !0} < %t.ll + * RUN: grep {!0 = metadata !\{i32 1, metadata !"metadata test"\}} < %t.ll + *) + let i = build_add p1 p2 "metadata" atentry in + insist ((has_metadata i) = false); + + let m1 = const_int i32_type 1 in + let m2 = mdstring context "metadata test" in + let md = mdnode context [| m1; m2 |] in + + let kind = mdkind_id context "test" in + set_metadata i kind md; + + insist ((has_metadata i) = true); + insist ((metadata i kind) = Some md); + + clear_metadata i kind; + + insist ((has_metadata i) = false); + insist ((metadata i kind) = None); + + set_metadata i kind md + end; + + group "dbg"; begin + (* RUN: grep {%dbg = add i32 %P1, %P2, !dbg !1} < %t.ll + * RUN: grep {!1 = metadata !\{i32 2, metadata !"dbg test"\}} < %t.ll + *) + let m1 = const_int i32_type 2 in + let m2 = mdstring context "dbg test" in + let md = mdnode context [| m1; m2 |] in + set_current_debug_location atentry md; + + let i = build_add p1 p2 "dbg" atentry in + insist ((has_metadata i) = true); + + clear_current_debug_location atentry + end; group "phi"; begin (* RUN: grep {PhiNode.*P1.*PhiBlock1.*P2.*PhiBlock2} < %t.ll