[llvm] r286705 - [OCaml] Adapt to the new attribute C API.
whitequark via llvm-commits
llvm-commits at lists.llvm.org
Fri Nov 11 19:38:30 PST 2016
Author: whitequark
Date: Fri Nov 11 21:38:30 2016
New Revision: 286705
URL: http://llvm.org/viewvc/llvm-project?rev=286705&view=rev
Log:
[OCaml] Adapt to the new attribute C API.
Modified:
llvm/trunk/bindings/ocaml/llvm/llvm.ml
llvm/trunk/bindings/ocaml/llvm/llvm.mli
llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
llvm/trunk/docs/ReleaseNotes.rst
llvm/trunk/test/Bindings/OCaml/core.ml
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.ml?rev=286705&r1=286704&r2=286705&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Fri Nov 11 21:38:30 2016
@@ -15,6 +15,8 @@ type llvalue
type lluse
type llbasicblock
type llbuilder
+type llattrkind
+type llattribute
type llmemorybuffer
type llmdkind
@@ -81,6 +83,25 @@ module CallConv = struct
let x86_fastcall = 65
end
+module AttrRepr = struct
+ type t =
+ | Enum of llattrkind * int64
+ | String of string * string
+end
+
+module AttrIndex = struct
+ type t =
+ | Function
+ | Return
+ | Param of int
+
+ let to_int index =
+ match index with
+ | Function -> -1
+ | Return -> 0
+ | Param(n) -> 1 + n
+end
+
module Attribute = struct
type t =
| Zext
@@ -332,6 +353,47 @@ external dispose_context : llcontext ->
external global_context : unit -> llcontext = "llvm_global_context"
external mdkind_id : llcontext -> string -> llmdkind = "llvm_mdkind_id"
+(*===-- Attributes --------------------------------------------------------===*)
+exception UnknownAttribute of string
+
+let () = Callback.register_exception "Llvm.UnknownAttribute"
+ (UnknownAttribute "")
+
+external enum_attr_kind : string -> llattrkind = "llvm_enum_attr_kind"
+external llvm_create_enum_attr : llcontext -> llattrkind -> int64 ->
+ llattribute
+ = "llvm_create_enum_attr_by_kind"
+external is_enum_attr : llattribute -> bool = "llvm_is_enum_attr"
+external get_enum_attr_kind : llattribute -> llattrkind
+ = "llvm_get_enum_attr_kind"
+external get_enum_attr_value : llattribute -> int64
+ = "llvm_get_enum_attr_value"
+external llvm_create_string_attr : llcontext -> string -> string ->
+ llattribute
+ = "llvm_create_string_attr"
+external is_string_attr : llattribute -> bool = "llvm_is_string_attr"
+external get_string_attr_kind : llattribute -> string
+ = "llvm_get_string_attr_kind"
+external get_string_attr_value : llattribute -> string
+ = "llvm_get_string_attr_value"
+
+let create_enum_attr context name value =
+ llvm_create_enum_attr context (enum_attr_kind name) value
+let create_string_attr context kind value =
+ llvm_create_string_attr context kind value
+
+let attr_of_repr context repr =
+ match repr with
+ | AttrRepr.Enum(kind, value) -> llvm_create_enum_attr context kind value
+ | AttrRepr.String(key, value) -> llvm_create_string_attr context key value
+
+let repr_of_attr attr =
+ if is_enum_attr attr then
+ AttrRepr.Enum(get_enum_attr_kind attr, get_enum_attr_value attr)
+ else if is_string_attr attr then
+ AttrRepr.String(get_string_attr_kind attr, get_string_attr_value attr)
+ else assert false
+
(*===-- Modules -----------------------------------------------------------===*)
external create_module : llcontext -> string -> llmodule = "llvm_create_module"
external dispose_module : llmodule -> unit = "llvm_dispose_module"
@@ -760,99 +822,27 @@ let rec fold_right_function_range f i e
let fold_right_functions f m init =
fold_right_function_range f (function_end m) (At_start m) init
-external llvm_add_function_attr : llvalue -> int32 -> unit
+external llvm_add_function_attr : llvalue -> llattribute -> int -> unit
= "llvm_add_function_attr"
-external llvm_remove_function_attr : llvalue -> int32 -> unit
- = "llvm_remove_function_attr"
-external llvm_function_attr : llvalue -> int32 = "llvm_function_attr"
-
-let pack_attr (attr:Attribute.t) : int32 =
- match attr with
- Attribute.Zext -> Int32.shift_left 1l 0
- | Attribute.Sext -> Int32.shift_left 1l 1
- | Attribute.Noreturn -> Int32.shift_left 1l 2
- | Attribute.Inreg -> Int32.shift_left 1l 3
- | Attribute.Structret -> Int32.shift_left 1l 4
- | Attribute.Nounwind -> Int32.shift_left 1l 5
- | Attribute.Noalias -> Int32.shift_left 1l 6
- | Attribute.Byval -> Int32.shift_left 1l 7
- | Attribute.Nest -> Int32.shift_left 1l 8
- | Attribute.Readnone -> Int32.shift_left 1l 9
- | Attribute.Readonly -> Int32.shift_left 1l 10
- | Attribute.Noinline -> Int32.shift_left 1l 11
- | Attribute.Alwaysinline -> Int32.shift_left 1l 12
- | Attribute.Optsize -> Int32.shift_left 1l 13
- | Attribute.Ssp -> Int32.shift_left 1l 14
- | Attribute.Sspreq -> Int32.shift_left 1l 15
- | Attribute.Alignment n -> Int32.shift_left (Int32.of_int n) 16
- | Attribute.Nocapture -> Int32.shift_left 1l 21
- | Attribute.Noredzone -> Int32.shift_left 1l 22
- | Attribute.Noimplicitfloat -> Int32.shift_left 1l 23
- | Attribute.Naked -> Int32.shift_left 1l 24
- | Attribute.Inlinehint -> Int32.shift_left 1l 25
- | Attribute.Stackalignment n -> Int32.shift_left (Int32.of_int n) 26
- | Attribute.ReturnsTwice -> Int32.shift_left 1l 29
- | Attribute.UWTable -> Int32.shift_left 1l 30
- | Attribute.NonLazyBind -> Int32.shift_left 1l 31
-
-let unpack_attr (a : int32) : Attribute.t list =
- let l = ref [] in
- let check attr =
- Int32.logand (pack_attr attr) a in
- let checkattr attr =
- if (check attr) <> 0l then begin
- l := attr :: !l
- end
- in
- checkattr Attribute.Zext;
- checkattr Attribute.Sext;
- checkattr Attribute.Noreturn;
- checkattr Attribute.Inreg;
- checkattr Attribute.Structret;
- checkattr Attribute.Nounwind;
- checkattr Attribute.Noalias;
- checkattr Attribute.Byval;
- checkattr Attribute.Nest;
- checkattr Attribute.Readnone;
- checkattr Attribute.Readonly;
- checkattr Attribute.Noinline;
- checkattr Attribute.Alwaysinline;
- checkattr Attribute.Optsize;
- checkattr Attribute.Ssp;
- checkattr Attribute.Sspreq;
- let align = Int32.logand (Int32.shift_right_logical a 16) 31l in
- if align <> 0l then
- l := Attribute.Alignment (Int32.to_int align) :: !l;
- checkattr Attribute.Nocapture;
- checkattr Attribute.Noredzone;
- checkattr Attribute.Noimplicitfloat;
- checkattr Attribute.Naked;
- checkattr Attribute.Inlinehint;
- let stackalign = Int32.logand (Int32.shift_right_logical a 26) 7l in
- if stackalign <> 0l then
- l := Attribute.Stackalignment (Int32.to_int stackalign) :: !l;
- checkattr Attribute.ReturnsTwice;
- checkattr Attribute.UWTable;
- checkattr Attribute.NonLazyBind;
- !l;;
-
-let add_function_attr llval attr =
- llvm_add_function_attr llval (pack_attr attr)
-
-external add_target_dependent_function_attr
- : llvalue -> string -> string -> unit
- = "llvm_add_target_dependent_function_attr"
-
-let remove_function_attr llval attr =
- llvm_remove_function_attr llval (pack_attr attr)
-
-let function_attr f = unpack_attr (llvm_function_attr f)
+external llvm_function_attrs : llvalue -> int -> llattribute array
+ = "llvm_function_attrs"
+external llvm_remove_enum_function_attr : llvalue -> llattrkind -> int -> unit
+ = "llvm_remove_enum_function_attr"
+external llvm_remove_string_function_attr : llvalue -> string -> int -> unit
+ = "llvm_remove_string_function_attr"
+
+let add_function_attr f a i =
+ llvm_add_function_attr f a (AttrIndex.to_int i)
+let function_attrs f i =
+ llvm_function_attrs f (AttrIndex.to_int i)
+let remove_enum_function_attr f k i =
+ llvm_remove_enum_function_attr f k (AttrIndex.to_int i)
+let remove_string_function_attr f k i =
+ llvm_remove_string_function_attr f k (AttrIndex.to_int i)
(*--... Operations on params ...............................................--*)
external params : llvalue -> llvalue array = "llvm_params"
external param : llvalue -> int -> llvalue = "llvm_param"
-external llvm_param_attr : llvalue -> int32 = "llvm_param_attr"
-let param_attr p = unpack_attr (llvm_param_attr p)
external param_parent : llvalue -> llvalue = "LLVMGetParamParent"
external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin"
external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ"
@@ -899,20 +889,6 @@ let rec fold_right_param_range f init i
let fold_right_params f fn init =
fold_right_param_range f init (param_end fn) (At_start fn)
-external llvm_add_param_attr : llvalue -> int32 -> unit
- = "llvm_add_param_attr"
-external llvm_remove_param_attr : llvalue -> int32 -> unit
- = "llvm_remove_param_attr"
-
-let add_param_attr llval attr =
- llvm_add_param_attr llval (pack_attr attr)
-
-let remove_param_attr llval attr =
- llvm_remove_param_attr llval (pack_attr attr)
-
-external set_param_alignment : llvalue -> int -> unit
- = "llvm_set_param_alignment"
-
(*--... Operations on basic blocks .........................................--*)
external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
external value_is_block : llvalue -> bool = "llvm_value_is_block"
@@ -1044,16 +1020,23 @@ external instruction_call_conv: llvalue
external set_instruction_call_conv: int -> llvalue -> unit
= "llvm_set_instruction_call_conv"
-external llvm_add_instruction_param_attr : llvalue -> int -> int32 -> unit
- = "llvm_add_instruction_param_attr"
-external llvm_remove_instruction_param_attr : llvalue -> int -> int32 -> unit
- = "llvm_remove_instruction_param_attr"
-
-let add_instruction_param_attr llval i attr =
- llvm_add_instruction_param_attr llval i (pack_attr attr)
-
-let remove_instruction_param_attr llval i attr =
- llvm_remove_instruction_param_attr llval i (pack_attr attr)
+external llvm_add_call_site_attr : llvalue -> llattribute -> int -> unit
+ = "llvm_add_call_site_attr"
+external llvm_call_site_attrs : llvalue -> int -> llattribute array
+ = "llvm_call_site_attrs"
+external llvm_remove_enum_call_site_attr : llvalue -> llattrkind -> int -> unit
+ = "llvm_remove_enum_call_site_attr"
+external llvm_remove_string_call_site_attr : llvalue -> string -> int -> unit
+ = "llvm_remove_string_call_site_attr"
+
+let add_call_site_attr f a i =
+ llvm_add_call_site_attr f a (AttrIndex.to_int i)
+let call_site_attrs f i =
+ llvm_call_site_attrs f (AttrIndex.to_int i)
+let remove_enum_call_site_attr f k i =
+ llvm_remove_enum_call_site_attr f k (AttrIndex.to_int i)
+let remove_string_call_site_attr f k i =
+ llvm_remove_string_call_site_attr f k (AttrIndex.to_int i)
(*--... Operations on call instructions (only) .............................--*)
external is_tail_call : llvalue -> bool = "llvm_is_tail_call"
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.mli?rev=286705&r1=286704&r2=286705&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.mli (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.mli Fri Nov 11 21:38:30 2016
@@ -44,6 +44,12 @@ type llbasicblock
class. *)
type llbuilder
+(** Used to represent attribute kinds. *)
+type llattrkind
+
+(** An attribute in LLVM IR. See the [llvm::Attribute] class. *)
+type llattribute
+
(** Used to efficiently handle large buffers of read-only binary data.
See the [llvm::MemoryBuffer] class. *)
type llmemorybuffer
@@ -130,36 +136,19 @@ module CallConv : sig
convention from C. *)
end
-(** The attribute kind of a function parameter, result or the function itself.
- See [llvm::Attribute::AttrKind]. *)
-module Attribute : sig
+(** The logical representation of an attribute. *)
+module AttrRepr : sig
type t =
- | Zext
- | Sext
- | Noreturn
- | Inreg
- | Structret
- | Nounwind
- | Noalias
- | Byval
- | Nest
- | Readnone
- | Readonly
- | Noinline
- | Alwaysinline
- | Optsize
- | Ssp
- | Sspreq
- | Alignment of int
- | Nocapture
- | Noredzone
- | Noimplicitfloat
- | Naked
- | Inlinehint
- | Stackalignment of int
- | ReturnsTwice
- | UWTable
- | NonLazyBind
+ | Enum of llattrkind * int64
+ | String of string * string
+end
+
+(** The position of an attribute. See [LLVMAttributeIndex]. *)
+module AttrIndex : sig
+ type t =
+ | Function
+ | Return
+ | Param of int
end
(** The predicate for an integer comparison ([icmp]) instruction.
@@ -443,6 +432,36 @@ val global_context : unit -> llcontext
val mdkind_id : llcontext -> string -> llmdkind
+(** {6 Attributes} *)
+
+(** [UnknownAttribute attr] is raised when a enum attribute name [name]
+ is not recognized by LLVM. *)
+exception UnknownAttribute of string
+
+(** [enum_attr_kind name] returns the kind of enum attributes named [name].
+ May raise [UnknownAttribute]. *)
+val enum_attr_kind : string -> llattrkind
+
+(** [create_enum_attr context value kind] creates an enum attribute
+ with the supplied [kind] and [value] in [context]; if the value
+ is not required (as for the majority of attributes), use [0L].
+ May raise [UnknownAttribute].
+ See the constructor [llvm::Attribute::get]. *)
+val create_enum_attr : llcontext -> string -> int64 -> llattribute
+
+(** [create_string_attr context kind value] creates a string attribute
+ with the supplied [kind] and [value] in [context].
+ See the constructor [llvm::Attribute::get]. *)
+val create_string_attr : llcontext -> string -> string -> llattribute
+
+(** [attr_of_repr context repr] creates an attribute with the supplied
+ representation [repr] in [context]. *)
+val attr_of_repr : llcontext -> AttrRepr.t -> llattribute
+
+(** [repr_of_attr attr] describes the representation of attribute [attr]. *)
+val repr_of_attr : llattribute -> AttrRepr.t
+
+
(** {6 Modules} *)
(** [create_module context id] creates a module with the supplied module ID in
@@ -1547,21 +1566,21 @@ val gc : llvalue -> string option
[gc]. See the method [llvm::Function::setGC]. *)
val set_gc : string option -> llvalue -> unit
-(** [add_function_attr f a] adds attribute [a] to the return type of function
- [f]. *)
-val add_function_attr : llvalue -> Attribute.t -> unit
-
-(** [add_target_dependent_function_attr f a] adds target-dependent attribute
- [a] to function [f]. *)
-val add_target_dependent_function_attr : llvalue -> string -> string -> unit
-
-(** [function_attr f] returns the function attribute for the function [f].
- See the method [llvm::Function::getAttributes] *)
-val function_attr : llvalue -> Attribute.t list
-
-(** [remove_function_attr f a] removes attribute [a] from the return type of
- function [f]. *)
-val remove_function_attr : llvalue -> Attribute.t -> unit
+(** [add_function_attr f a i] adds attribute [a] to the function [f]
+ at position [i]. *)
+val add_function_attr : llvalue -> llattribute -> AttrIndex.t -> unit
+
+(** [function_attrs f i] returns the attributes for the function [f]
+ at position [i]. *)
+val function_attrs : llvalue -> AttrIndex.t -> llattribute array
+
+(** [remove_enum_function_attr f k i] removes enum attribute with kind [k]
+ from the function [f] at position [i]. *)
+val remove_enum_function_attr : llvalue -> llattrkind -> AttrIndex.t -> unit
+
+(** [remove_string_function_attr f k i] removes string attribute with kind [k]
+ from the function [f] at position [i]. *)
+val remove_string_function_attr : llvalue -> string -> AttrIndex.t -> unit
(** {7 Operations on params} *)
@@ -1574,11 +1593,6 @@ val params : llvalue -> llvalue array
See the method [llvm::Function::getArgumentList]. *)
val param : llvalue -> int -> llvalue
-(** [param_attr p] returns the attributes of parameter [p].
- See the methods [llvm::Function::getAttributes] and
- [llvm::Attributes::getParamAttributes] *)
-val param_attr : llvalue -> Attribute.t list
-
(** [param_parent p] returns the parent function that owns the parameter.
See the method [llvm::Argument::getParent]. *)
val param_parent : llvalue -> llvalue
@@ -1620,15 +1634,6 @@ val rev_iter_params : (llvalue -> unit)
[b1,...,bN] are the parameters of function [fn]. Tail recursive. *)
val fold_right_params : (llvalue -> 'a -> 'a) -> llvalue -> 'a -> 'a
-(** [add_param p a] adds attribute [a] to parameter [p]. *)
-val add_param_attr : llvalue -> Attribute.t -> unit
-
-(** [remove_param_attr p a] removes attribute [a] from parameter [p]. *)
-val remove_param_attr : llvalue -> Attribute.t -> unit
-
-(** [set_param_alignment p a] set the alignment of parameter [p] to [a]. *)
-val set_param_alignment : llvalue -> int -> unit
-
(** {7 Operations on basic blocks} *)
@@ -1797,15 +1802,21 @@ val instruction_call_conv: llvalue -> in
and [llvm::InvokeInst::setCallingConv]. *)
val set_instruction_call_conv: int -> llvalue -> unit
-(** [add_instruction_param_attr ci i a] adds attribute [a] to the [i]th
- parameter of the call or invoke instruction [ci]. [i]=0 denotes the return
- value. *)
-val add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
-
-(** [remove_instruction_param_attr ci i a] removes attribute [a] from the
- [i]th parameter of the call or invoke instruction [ci]. [i]=0 denotes the
- return value. *)
-val remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
+(** [add_call_site_attr f a i] adds attribute [a] to the call instruction [ci]
+ at position [i]. *)
+val add_call_site_attr : llvalue -> llattribute -> AttrIndex.t -> unit
+
+(** [call_site_attr f i] returns the attributes for the call instruction [ci]
+ at position [i]. *)
+val call_site_attrs : llvalue -> AttrIndex.t -> llattribute array
+
+(** [remove_enum_call_site_attr f k i] removes enum attribute with kind [k]
+ from the call instruction [ci] at position [i]. *)
+val remove_enum_call_site_attr : llvalue -> llattrkind -> AttrIndex.t -> unit
+
+(** [remove_string_call_site_attr f k i] removes string attribute with kind [k]
+ from the call instruction [ci] at position [i]. *)
+val remove_string_call_site_attr : llvalue -> string -> AttrIndex.t -> unit
(** {7 Operations on call instructions (only)} *)
Modified: llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c?rev=286705&r1=286704&r2=286705&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c Fri Nov 11 21:38:30 2016
@@ -185,6 +185,69 @@ CAMLprim value llvm_mdkind_id(LLVMContex
return Val_int(MDKindID);
}
+/*===-- Attributes --------------------------------------------------------===*/
+
+/* string -> llattrkind */
+CAMLprim value llvm_enum_attr_kind(value Name) {
+ unsigned Kind = LLVMGetEnumAttributeKindForName(
+ String_val(Name), caml_string_length(Name));
+ if(Kind == 0)
+ caml_raise_with_arg(*caml_named_value("Llvm.UnknownAttribute"), Name);
+ return Val_int(Kind);
+}
+
+/* llcontext -> int -> int64 -> llattribute */
+CAMLprim LLVMAttributeRef
+llvm_create_enum_attr_by_kind(LLVMContextRef C, value Kind, value Value) {
+ return LLVMCreateEnumAttribute(C, Int_val(Kind), Int64_val(Value));
+}
+
+/* llattribute -> bool */
+CAMLprim value llvm_is_enum_attr(LLVMAttributeRef A) {
+ return Val_int(LLVMIsEnumAttribute(A));
+}
+
+/* llattribute -> llattrkind */
+CAMLprim value llvm_get_enum_attr_kind(LLVMAttributeRef A) {
+ return Val_int(LLVMGetEnumAttributeKind(A));
+}
+
+/* llattribute -> int64 */
+CAMLprim value llvm_get_enum_attr_value(LLVMAttributeRef A) {
+ return caml_copy_int64(LLVMGetEnumAttributeValue(A));
+}
+
+/* llcontext -> kind:string -> name:string -> llattribute */
+CAMLprim LLVMAttributeRef llvm_create_string_attr(LLVMContextRef C,
+ value Kind, value Value) {
+ return LLVMCreateStringAttribute(C,
+ String_val(Kind), caml_string_length(Kind),
+ String_val(Value), caml_string_length(Value));
+}
+
+/* llattribute -> bool */
+CAMLprim value llvm_is_string_attr(LLVMAttributeRef A) {
+ return Val_int(LLVMIsStringAttribute(A));
+}
+
+/* llattribute -> string */
+CAMLprim value llvm_get_string_attr_kind(LLVMAttributeRef A) {
+ unsigned Length;
+ const char *String = LLVMGetStringAttributeKind(A, &Length);
+ value Result = caml_alloc_string(Length);
+ memcpy(String_val(Result), String, Length);
+ return Result;
+}
+
+/* llattribute -> string */
+CAMLprim value llvm_get_string_attr_value(LLVMAttributeRef A) {
+ unsigned Length;
+ const char *String = LLVMGetStringAttributeValue(A, &Length);
+ value Result = caml_alloc_string(Length);
+ memcpy(String_val(Result), String, Length);
+ return Result;
+}
+
/*===-- Modules -----------------------------------------------------------===*/
/* llcontext -> string -> llmodule */
@@ -1308,31 +1371,37 @@ CAMLprim value llvm_set_gc(value GC, LLV
return Val_unit;
}
-/* llvalue -> int32 -> unit */
-CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
- LLVMAddFunctionAttr(Arg, Int32_val(PA));
+/* llvalue -> llattribute -> int -> unit */
+CAMLprim value llvm_add_function_attr(LLVMValueRef F, LLVMAttributeRef A,
+ value Index) {
+ LLVMAddAttributeAtIndex(F, Int_val(Index), A);
return Val_unit;
}
-/* llvalue -> string -> string -> unit */
-CAMLprim value llvm_add_target_dependent_function_attr(
- LLVMValueRef Arg, value A, value V) {
- LLVMAddTargetDependentFunctionAttr(Arg, String_val(A), String_val(V));
- return Val_unit;
+/* llvalue -> int -> llattribute array */
+CAMLprim value llvm_function_attrs(LLVMValueRef F, value Index) {
+ unsigned Length = LLVMGetAttributeCountAtIndex(F, Int_val(Index));
+ value Array = caml_alloc(Length, 0);
+ LLVMGetAttributesAtIndex(F, Int_val(Index),
+ (LLVMAttributeRef *) Op_val(Array));
+ return Array;
}
-/* llvalue -> int32 */
-CAMLprim value llvm_function_attr(LLVMValueRef Fn)
-{
- CAMLparam0();
- CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
+/* llvalue -> llattrkind -> int -> unit */
+CAMLprim value llvm_remove_enum_function_attr(LLVMValueRef F, value Kind,
+ value Index) {
+ LLVMRemoveEnumAttributeAtIndex(F, Int_val(Index), Int_val(Kind));
+ return Val_unit;
}
-/* llvalue -> int32 -> unit */
-CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
- LLVMRemoveFunctionAttr(Arg, Int32_val(PA));
+/* llvalue -> string -> int -> unit */
+CAMLprim value llvm_remove_string_function_attr(LLVMValueRef F, value Kind,
+ value Index) {
+ LLVMRemoveStringAttributeAtIndex(F, Int_val(Index), String_val(Kind),
+ caml_string_length(Kind));
return Val_unit;
}
+
/*--... Operations on parameters ...........................................--*/
DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
@@ -1342,13 +1411,6 @@ CAMLprim LLVMValueRef llvm_param(LLVMVal
return LLVMGetParam(Fn, Int_val(Index));
}
-/* llvalue -> int */
-CAMLprim value llvm_param_attr(LLVMValueRef Param)
-{
- CAMLparam0();
- CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
-}
-
/* llvalue -> llvalue */
CAMLprim value llvm_params(LLVMValueRef Fn) {
value Params = alloc(LLVMCountParams(Fn), 0);
@@ -1356,24 +1418,6 @@ CAMLprim value llvm_params(LLVMValueRef
return Params;
}
-/* llvalue -> int32 -> unit */
-CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
- LLVMAddAttribute(Arg, Int32_val(PA));
- return Val_unit;
-}
-
-/* llvalue -> int32 -> unit */
-CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
- LLVMRemoveAttribute(Arg, Int32_val(PA));
- return Val_unit;
-}
-
-/* llvalue -> int -> unit */
-CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
- LLVMSetParamAlignment(Arg, Int_val(align));
- return Val_unit;
-}
-
/*--... Operations on basic blocks .........................................--*/
DEFINE_ITERATORS(
@@ -1500,19 +1544,34 @@ CAMLprim value llvm_set_instruction_call
return Val_unit;
}
-/* llvalue -> int -> int32 -> unit */
-CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
- value index,
- value PA) {
- LLVMAddInstrAttribute(Instr, Int_val(index), Int32_val(PA));
+/* llvalue -> llattribute -> int -> unit */
+CAMLprim value llvm_add_call_site_attr(LLVMValueRef F, LLVMAttributeRef A,
+ value Index) {
+ LLVMAddCallSiteAttribute(F, Int_val(Index), A);
+ return Val_unit;
+}
+
+/* llvalue -> int -> llattribute array */
+CAMLprim value llvm_call_site_attrs(LLVMValueRef F, value Index) {
+ unsigned Count = LLVMGetCallSiteAttributeCount(F, Int_val(Index));
+ value Array = caml_alloc(Count, 0);
+ LLVMGetCallSiteAttributes(F, Int_val(Index),
+ (LLVMAttributeRef *)Op_val(Array));
+ return Array;
+}
+
+/* llvalue -> llattrkind -> int -> unit */
+CAMLprim value llvm_remove_enum_call_site_attr(LLVMValueRef F, value Kind,
+ value Index) {
+ LLVMRemoveCallSiteEnumAttribute(F, Int_val(Index), Int_val(Kind));
return Val_unit;
}
-/* llvalue -> int -> int32 -> unit */
-CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
- value index,
- value PA) {
- LLVMRemoveInstrAttribute(Instr, Int_val(index), Int32_val(PA));
+/* llvalue -> string -> int -> unit */
+CAMLprim value llvm_remove_string_call_site_attr(LLVMValueRef F, value Kind,
+ value Index) {
+ LLVMRemoveCallSiteStringAttribute(F, Int_val(Index), String_val(Kind),
+ caml_string_length(Kind));
return Val_unit;
}
Modified: llvm/trunk/docs/ReleaseNotes.rst
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/docs/ReleaseNotes.rst?rev=286705&r1=286704&r2=286705&view=diff
==============================================================================
--- llvm/trunk/docs/ReleaseNotes.rst (original)
+++ llvm/trunk/docs/ReleaseNotes.rst Fri Nov 11 21:38:30 2016
@@ -98,7 +98,8 @@ Changes to the AMDGPU Target
Changes to the OCaml bindings
-----------------------------
- During this release ...
+* The attribute API was completely overhauled, following the changes
+ to the C API.
External Open Source Projects Using LLVM 4.0.0
Modified: llvm/trunk/test/Bindings/OCaml/core.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/OCaml/core.ml?rev=286705&r1=286704&r2=286705&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/OCaml/core.ml (original)
+++ llvm/trunk/test/Bindings/OCaml/core.ml Fri Nov 11 21:38:30 2016
@@ -404,6 +404,42 @@ let test_constants () =
end
+(*===-- Attributes --------------------------------------------------------===*)
+
+let test_attributes () =
+ group "enum attrs";
+ let nonnull_kind = enum_attr_kind "nonnull" in
+ let dereferenceable_kind = enum_attr_kind "dereferenceable" in
+ insist (nonnull_kind = (enum_attr_kind "nonnull"));
+ insist (nonnull_kind <> dereferenceable_kind);
+
+ let nonnull =
+ create_enum_attr context "nonnull" 0L in
+ let dereferenceable_4 =
+ create_enum_attr context "dereferenceable" 4L in
+ let dereferenceable_8 =
+ create_enum_attr context "dereferenceable" 8L in
+ insist (nonnull <> dereferenceable_4);
+ insist (dereferenceable_4 <> dereferenceable_8);
+ insist (nonnull = (create_enum_attr context "nonnull" 0L));
+ insist ((repr_of_attr nonnull) =
+ AttrRepr.Enum(nonnull_kind, 0L));
+ insist ((repr_of_attr dereferenceable_4) =
+ AttrRepr.Enum(dereferenceable_kind, 4L));
+ insist ((attr_of_repr context (repr_of_attr nonnull)) =
+ nonnull);
+ insist ((attr_of_repr context (repr_of_attr dereferenceable_4)) =
+ dereferenceable_4);
+
+ group "string attrs";
+ let foo_bar = create_string_attr context "foo" "bar" in
+ let foo_baz = create_string_attr context "foo" "baz" in
+ insist (foo_bar <> foo_baz);
+ insist (foo_bar = (create_string_attr context "foo" "bar"));
+ insist ((repr_of_attr foo_bar) = AttrRepr.String("foo", "bar"));
+ insist ((attr_of_repr context (repr_of_attr foo_bar)) = foo_bar);
+ ()
+
(*===-- Global Values -----------------------------------------------------===*)
let test_global_values () =
@@ -747,12 +783,6 @@ let test_params () =
let p2 = param f 1 in
set_value_name "One" p1;
set_value_name "Two" p2;
- add_param_attr p1 Attribute.Sext;
- add_param_attr p2 Attribute.Noalias;
- remove_param_attr p2 Attribute.Noalias;
- add_function_attr f Attribute.Nounwind;
- add_function_attr f Attribute.Noreturn;
- remove_function_attr f Attribute.Noreturn;
insist (Before p1 = param_begin f);
insist (Before p2 = param_succ p1);
@@ -960,11 +990,25 @@ let test_builder () =
group "function attribute";
begin
- ignore (add_function_attr fn Attribute.UWTable);
- (* CHECK: X7{{.*}}#0{{.*}}personality{{.*}}@__gxx_personality_v0
- * #0 is uwtable, defined at EOF.
- *)
- insist ([Attribute.UWTable] = function_attr fn);
+ let signext = create_enum_attr context "signext" 0L in
+ let zeroext = create_enum_attr context "zeroext" 0L in
+ let noalias = create_enum_attr context "noalias" 0L in
+ let nounwind = create_enum_attr context "nounwind" 0L in
+ let no_sse = create_string_attr context "no-sse" "" in
+
+ add_function_attr fn signext (AttrIndex.Param 0);
+ add_function_attr fn noalias (AttrIndex.Param 1);
+ insist ((function_attrs fn (AttrIndex.Param 1)) = [|noalias|]);
+ remove_enum_function_attr fn (enum_attr_kind "noalias") (AttrIndex.Param 1);
+ add_function_attr fn no_sse (AttrIndex.Param 1);
+ insist ((function_attrs fn (AttrIndex.Param 1)) = [|no_sse|]);
+ remove_string_function_attr fn "no-sse" (AttrIndex.Param 1);
+ insist ((function_attrs fn (AttrIndex.Param 1)) = [||]);
+ add_function_attr fn nounwind AttrIndex.Function;
+ add_function_attr fn zeroext AttrIndex.Return;
+
+ (* CHECK: define zeroext i32 @X7(i32 signext %P1, i32 %P2)
+ *)
end;
group "casts"; begin
@@ -1057,7 +1101,7 @@ let test_builder () =
end;
group "miscellaneous"; begin
- (* CHECK: %build_call = tail call cc63 i32 @{{.*}}(i32 signext %P2, i32 %P1)
+ (* CHECK: %build_call = tail call cc63 zeroext i32 @{{.*}}(i32 signext %P2, i32 %P1)
* CHECK: %build_select = select i1 %build_icmp, i32 %P1, i32 %P2
* CHECK: %build_va_arg = va_arg i8** null, i32
* CHECK: %build_extractelement = extractelement <4 x i32> %Vec1, i32 %P2
@@ -1073,9 +1117,23 @@ let test_builder () =
insist (not (is_tail_call ci));
set_tail_call true ci;
insist (is_tail_call ci);
- add_instruction_param_attr ci 1 Attribute.Sext;
- add_instruction_param_attr ci 2 Attribute.Noalias;
- remove_instruction_param_attr ci 2 Attribute.Noalias;
+
+ let signext = create_enum_attr context "signext" 0L in
+ let zeroext = create_enum_attr context "zeroext" 0L in
+ let noalias = create_enum_attr context "noalias" 0L in
+ let noreturn = create_enum_attr context "noreturn" 0L in
+ let no_sse = create_string_attr context "no-sse" "" in
+
+ add_call_site_attr ci signext (AttrIndex.Param 0);
+ add_call_site_attr ci noalias (AttrIndex.Param 1);
+ insist ((call_site_attrs ci (AttrIndex.Param 1)) = [|noalias|]);
+ remove_enum_call_site_attr ci (enum_attr_kind "noalias") (AttrIndex.Param 1);
+ add_call_site_attr ci no_sse (AttrIndex.Param 1);
+ insist ((call_site_attrs ci (AttrIndex.Param 1)) = [|no_sse|]);
+ remove_string_call_site_attr ci "no-sse" (AttrIndex.Param 1);
+ insist ((call_site_attrs ci (AttrIndex.Param 1)) = [||]);
+ add_call_site_attr ci noreturn AttrIndex.Function;
+ add_call_site_attr ci zeroext AttrIndex.Return;
let inst46 = build_icmp Icmp.Eq p1 p2 "build_icmp" atentry in
ignore (build_select inst46 p1 p2 "build_select" atentry);
@@ -1421,7 +1479,6 @@ let test_builder () =
end
(* End-of-file checks for things like metdata and attributes.
- * CHECK: attributes #0 = {{.*}}uwtable{{.*}}
* CHECK: !llvm.module.flags = !{!0}
* CHECK: !0 = !{i32 1, !"Debug Info Version", i32 3}
* CHECK: !1 = !{i32 1, !"metadata test"}
@@ -1479,6 +1536,7 @@ let _ =
suite "conversion" test_conversion;
suite "target" test_target;
suite "constants" test_constants;
+ suite "attributes" test_attributes;
suite "global values" test_global_values;
suite "global variables" test_global_variables;
suite "uses" test_uses;
More information about the llvm-commits
mailing list