summaryrefslogtreecommitdiff
path: root/bindings
diff options
context:
space:
mode:
authorwhitequark <whitequark@whitequark.org>2016-11-12 03:38:30 +0000
committerwhitequark <whitequark@whitequark.org>2016-11-12 03:38:30 +0000
commit18c0ee263804d2d736405b66898309583ee8385e (patch)
tree33249123892604f22329982c7379221af7a9bc4b /bindings
parentb1cfc87891b4cb41ec94457a0d42d8c1fd57faf6 (diff)
downloadllvm-18c0ee263804d2d736405b66898309583ee8385e.tar.gz
[OCaml] Adapt to the new attribute C API.
git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@286705 91177308-0d34-0410-b5e6-96231b3b80d8
Diffstat (limited to 'bindings')
-rw-r--r--bindings/ocaml/llvm/llvm.ml207
-rw-r--r--bindings/ocaml/llvm/llvm.mli137
-rw-r--r--bindings/ocaml/llvm/llvm_ocaml.c161
3 files changed, 279 insertions, 226 deletions
diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 513fe0c96870..399fd2d27c20 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -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 -> unit = "llvm_dispose_context"
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 init =
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 e =
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 -> int
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"
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 0f973000f754..4068126e2cbf 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -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 =
+ | Enum of llattrkind * int64
+ | String of string * string
+end
+
+(** The position of an attribute. See [LLVMAttributeIndex]. *)
+module AttrIndex : 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
+ | 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_function_attr f a i] adds attribute [a] to the function [f]
+ at position [i]. *)
+val add_function_attr : llvalue -> llattribute -> AttrIndex.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_attrs f i] returns the attributes for the function [f]
+ at position [i]. *)
+val function_attrs : llvalue -> AttrIndex.t -> llattribute array
-(** [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_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_function_attr f a] removes attribute [a] from the return type of
- function [f]. *)
-val remove_function_attr : llvalue -> Attribute.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) -> 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 -> int
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
+(** [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_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
+(** [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)} *)
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index f968db8efd03..af04ea25c8ab 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -185,6 +185,69 @@ CAMLprim value llvm_mdkind_id(LLVMContextRef C, value Name) {
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, LLVMValueRef Fn) {
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(LLVMValueRef Fn, value Index) {
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 Fn) {
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_conv(value CC, LLVMValueRef Inst) {
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;
}