diff options
author | whitequark <whitequark@whitequark.org> | 2016-11-12 03:38:30 +0000 |
---|---|---|
committer | whitequark <whitequark@whitequark.org> | 2016-11-12 03:38:30 +0000 |
commit | 18c0ee263804d2d736405b66898309583ee8385e (patch) | |
tree | 33249123892604f22329982c7379221af7a9bc4b /bindings | |
parent | b1cfc87891b4cb41ec94457a0d42d8c1fd57faf6 (diff) | |
download | llvm-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.ml | 207 | ||||
-rw-r--r-- | bindings/ocaml/llvm/llvm.mli | 137 | ||||
-rw-r--r-- | bindings/ocaml/llvm/llvm_ocaml.c | 161 |
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; } |