[llvm-commits] [llvm] r71081 - in /llvm/trunk: bindings/ocaml/llvm/llvm.ml bindings/ocaml/llvm/llvm.mli bindings/ocaml/llvm/llvm_ocaml.c include/llvm-c/Core.h lib/VMCore/Core.cpp test/Bindings/Ocaml/vmcore.ml
Duncan Sands
baldrick at free.fr
Wed May 6 05:21:35 PDT 2009
Author: baldrick
Date: Wed May 6 07:21:17 2009
New Revision: 71081
URL: http://llvm.org/viewvc/llvm-project?rev=71081&view=rev
Log:
OCaml parameter attribute bindings from PR2752.
Incomplete, but better than nothing.
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/include/llvm-c/Core.h
llvm/trunk/lib/VMCore/Core.cpp
llvm/trunk/test/Bindings/Ocaml/vmcore.ml
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.ml?rev=71081&r1=71080&r2=71081&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Wed May 6 07:21:17 2009
@@ -64,6 +64,21 @@
let x86_fastcall = 65
end
+module Attribute = struct
+ type t =
+ | Zext
+ | Sext
+ | Noreturn
+ | Inreg
+ | Structret
+ | Nounwind
+ | Noalias
+ | Byval
+ | Nest
+ | Readnone
+ | Readonly
+end
+
module Icmp = struct
type t =
| Eq
@@ -418,7 +433,10 @@
let fold_right_functions f m init =
fold_right_function_range f (function_end m) (At_start m) init
-(* TODO: param attrs *)
+external add_function_attr : llvalue -> Attribute.t -> unit
+ = "llvm_add_function_attr"
+external remove_function_attr : llvalue -> Attribute.t -> unit
+ = "llvm_remove_function_attr"
(*--... Operations on params ...............................................--*)
external params : llvalue -> llvalue array = "llvm_params"
@@ -469,6 +487,13 @@
let fold_right_params f fn init =
fold_right_param_range f init (param_end fn) (At_start fn)
+external add_param_attr : llvalue -> Attribute.t -> unit
+ = "llvm_add_param_attr"
+external remove_param_attr : llvalue -> Attribute.t -> unit
+ = "llvm_remove_param_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"
@@ -586,6 +611,10 @@
= "llvm_instruction_call_conv"
external set_instruction_call_conv: int -> llvalue -> unit
= "llvm_set_instruction_call_conv"
+external add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
+ = "llvm_add_instruction_param_attr"
+external remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
+ = "llvm_remove_instruction_param_attr"
(*--... 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=71081&r1=71080&r2=71081&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.mli (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.mli Wed May 6 07:21:17 2009
@@ -111,6 +111,21 @@
convention from C. *)
end
+module Attribute : sig
+ type t =
+ | Zext
+ | Sext
+ | Noreturn
+ | Inreg
+ | Structret
+ | Nounwind
+ | Noalias
+ | Byval
+ | Nest
+ | Readnone
+ | Readonly
+end
+
(** The predicate for an integer comparison ([icmp]) instruction.
See the [llvm::ICmpInst::Predicate] enumeration. *)
module Icmp : sig
@@ -931,6 +946,15 @@
[gc]. See the method [llvm::Function::setGC]. *)
external set_gc : string option -> llvalue -> unit = "llvm_set_gc"
+(** [add_function_attr f a] adds attribute [a] to the return type of function
+ [f]. *)
+external add_function_attr : llvalue -> Attribute.t -> unit
+ = "llvm_add_function_attr"
+
+(** [remove_function_attr f a] removes attribute [a] from the return type of
+ function [f]. *)
+external remove_function_attr : llvalue -> Attribute.t -> unit
+ = "llvm_remove_function_attr"
(** {7 Operations on params} *)
@@ -984,6 +1008,16 @@
[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]. *)
+external add_param_attr : llvalue -> Attribute.t -> unit = "llvm_add_param_attr"
+
+(** [remove_param_attr p a] removes attribute [a] from parameter [p]. *)
+external remove_param_attr : llvalue -> Attribute.t -> unit
+ = "llvm_remove_param_attr"
+
+(** [set_param_alignment p a] set the alignment of parameter [p] to [a]. *)
+external set_param_alignment : llvalue -> int -> unit
+ = "llvm_set_param_alignment"
(** {7 Operations on basic blocks} *)
@@ -1127,6 +1161,18 @@
external set_instruction_call_conv: int -> llvalue -> unit
= "llvm_set_instruction_call_conv"
+(** [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. *)
+external add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
+ = "llvm_add_instruction_param_attr"
+
+(** [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. *)
+external remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
+ = "llvm_remove_instruction_param_attr"
+
(** {Operations on call instructions (only)} *)
(** [is_tail_call ci] is [true] if the call instruction [ci] is flagged as
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=71081&r1=71080&r2=71081&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c Wed May 6 07:21:17 2009
@@ -665,6 +665,17 @@
return Val_unit;
}
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
+ LLVMAddFunctionAttr(Arg, 1<<Int_val(PA));
+ return Val_unit;
+}
+
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
+ LLVMRemoveFunctionAttr(Arg, 1<<Int_val(PA));
+ return Val_unit;
+}
/*--... Operations on parameters ...........................................--*/
DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
@@ -681,6 +692,24 @@
return Params;
}
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
+ LLVMAddAttribute(Arg, 1<<Int_val(PA));
+ return Val_unit;
+}
+
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
+ LLVMRemoveAttribute(Arg, 1<<Int_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(
@@ -733,6 +762,22 @@
return Val_unit;
}
+/* llvalue -> int -> Attribute.t -> unit */
+CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
+ value index,
+ value PA) {
+ LLVMAddInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
+ return Val_unit;
+}
+
+/* llvalue -> int -> Attribute.t -> unit */
+CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
+ value index,
+ value PA) {
+ LLVMRemoveInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
+ return Val_unit;
+}
+
/*--... Operations on call instructions (only) .............................--*/
/* llvalue -> bool */
Modified: llvm/trunk/include/llvm-c/Core.h
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/include/llvm-c/Core.h?rev=71081&r1=71080&r2=71081&view=diff
==============================================================================
--- llvm/trunk/include/llvm-c/Core.h (original)
+++ llvm/trunk/include/llvm-c/Core.h Wed May 6 07:21:17 2009
@@ -504,6 +504,8 @@
void LLVMSetFunctionCallConv(LLVMValueRef Fn, unsigned CC);
const char *LLVMGetGC(LLVMValueRef Fn);
void LLVMSetGC(LLVMValueRef Fn, const char *Name);
+void LLVMAddFunctionAttr(LLVMValueRef Fn, LLVMAttribute PA);
+void LLVMRemoveFunctionAttr(LLVMValueRef Fn, LLVMAttribute PA);
/* Operations on parameters */
unsigned LLVMCountParams(LLVMValueRef Fn);
Modified: llvm/trunk/lib/VMCore/Core.cpp
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/lib/VMCore/Core.cpp?rev=71081&r1=71080&r2=71081&view=diff
==============================================================================
--- llvm/trunk/lib/VMCore/Core.cpp (original)
+++ llvm/trunk/lib/VMCore/Core.cpp Wed May 6 07:21:17 2009
@@ -776,6 +776,20 @@
F->clearGC();
}
+void LLVMAddFunctionAttr(LLVMValueRef Fn, LLVMAttribute PA) {
+ Function *Func = unwrap<Function>(Fn);
+ const AttrListPtr PAL = Func->getAttributes();
+ const AttrListPtr PALnew = PAL.addAttr(0, PA);
+ Func->setAttributes(PALnew);
+}
+
+void LLVMRemoveFunctionAttr(LLVMValueRef Fn, LLVMAttribute PA) {
+ Function *Func = unwrap<Function>(Fn);
+ const AttrListPtr PAL = Func->getAttributes();
+ const AttrListPtr PALnew = PAL.removeAttr(0, PA);
+ Func->setAttributes(PALnew);
+}
+
/*--.. Operations on parameters ............................................--*/
unsigned LLVMCountParams(LLVMValueRef FnRef) {
Modified: llvm/trunk/test/Bindings/Ocaml/vmcore.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/vmcore.ml?rev=71081&r1=71080&r2=71081&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/vmcore.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/vmcore.ml Wed May 6 07:21:17 2009
@@ -626,7 +626,13 @@
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);
insist (At_end f = param_succ p2);
@@ -988,6 +994,10 @@
insist (not (is_tail_call ci));
set_tail_call true ci;
insist (is_tail_call ci);
+ add_instruction_param_attr ci 0 Attribute.Nounwind;
+ 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 inst46 = build_icmp Icmp.Eq p1 p2 "Inst46" atentry in
ignore (build_select inst46 p1 p2 "Inst47" atentry);
More information about the llvm-commits
mailing list