aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorErick Tryzelaar <idadesub@users.sourceforge.net>2010-02-28 09:45:59 +0000
committerErick Tryzelaar <idadesub@users.sourceforge.net>2010-02-28 09:45:59 +0000
commit46c80e0c5653e11ada7cebcb46f9a8f7df758e41 (patch)
treef3225fd81e03d98416d92c08cbce02e04100596f
parente0d2753f2b43ab595e341e45dbb874a330bd8d5f (diff)
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
-rw-r--r--bindings/ocaml/llvm/llvm.ml22
-rw-r--r--bindings/ocaml/llvm/llvm.mli62
-rw-r--r--bindings/ocaml/llvm/llvm_ocaml.c86
-rw-r--r--include/llvm-c/Core.h24
-rw-r--r--lib/VMCore/Core.cpp56
-rw-r--r--test/Bindings/Ocaml/vmcore.ml40
6 files changed, 289 insertions, 1 deletions
diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 0c2cebd6a2..837f6a3b74 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 98ba05f208..5a156428bf 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 2b6eb56d98..e56af1e753 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 8d4fca1981..1a29463e14 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 57705daa10..9f1ee17c54 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<Instruction>(Inst)->hasMetadata();
+}
+
+LLVMValueRef LLVMGetMetadata(LLVMValueRef Inst, unsigned KindID) {
+ return wrap(unwrap<Instruction>(Inst)->getMetadata(KindID));
+}
+
+void LLVMSetMetadata(LLVMValueRef Inst, unsigned KindID, LLVMValueRef MD) {
+ unwrap<Instruction>(Inst)->setMetadata(KindID, MD? unwrap<MDNode>(MD) : NULL);
+}
+
/*--.. Conversion functions ................................................--*/
#define LLVM_DEFINE_VALUE_CAST(name) \
@@ -493,6 +514,26 @@ LLVMValueRef LLVMConstPointerNull(LLVMTypeRef Ty) {
wrap(ConstantPointerNull::get(unwrap<PointerType>(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<Value>(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<MDNode>(L) : NULL);
+}
+
+LLVMValueRef LLVMGetCurrentDebugLocation(LLVMBuilderRef Builder) {
+ return wrap(unwrap(Builder)->getCurrentDebugLocation());
+}
+
+void LLVMSetInstDebugLocation(LLVMBuilderRef Builder, LLVMValueRef Inst) {
+ unwrap(Builder)->SetInstDebugLocation(unwrap<Instruction>(Inst));
+}
+
+
/*--.. Instruction builders ................................................--*/
LLVMValueRef LLVMBuildRetVoid(LLVMBuilderRef B) {
diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index 48c1a9570a..57a842583f 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