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
This commit is contained in:
Erick Tryzelaar 2010-02-28 09:45:59 +00:00
parent e0d2753f2b
commit 46c80e0c56
6 changed files with 289 additions and 1 deletions

View File

@ -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"

View File

@ -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} *)

View File

@ -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 */

View File

@ -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);

View File

@ -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) {

View File

@ -1090,6 +1090,46 @@ let test_builder () =
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
*)