From e149e9960ba0726f4b084763f7ef95afa12d9a88 Mon Sep 17 00:00:00 2001 From: Duncan Sands Date: Wed, 6 May 2009 12:21:17 +0000 Subject: [PATCH] OCaml parameter attribute bindings from PR2752. Incomplete, but better than nothing. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@71081 91177308-0d34-0410-b5e6-96231b3b80d8 --- bindings/ocaml/llvm/llvm.ml | 31 ++++++++++++++++++++- bindings/ocaml/llvm/llvm.mli | 46 ++++++++++++++++++++++++++++++++ bindings/ocaml/llvm/llvm_ocaml.c | 45 +++++++++++++++++++++++++++++++ include/llvm-c/Core.h | 2 ++ lib/VMCore/Core.cpp | 14 ++++++++++ test/Bindings/Ocaml/vmcore.ml | 12 ++++++++- 6 files changed, 148 insertions(+), 2 deletions(-) diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 438663e5d2b..a3a614d51f6 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -64,6 +64,21 @@ module CallConv = struct 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 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 -(* 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 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 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 @@ external instruction_call_conv: llvalue -> int = "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" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 06d4b21c8d1..421c20cba96 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -111,6 +111,21 @@ module CallConv : sig 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 @@ external gc : llvalue -> string option = "llvm_gc" [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 @@ 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]. *) +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 instruction_call_conv: llvalue -> int 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 diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 35cd7d23607..c4eba13db0f 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -665,6 +665,17 @@ CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) { return Val_unit; } +/* llvalue -> Attribute.t -> unit */ +CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) { + LLVMAddFunctionAttr(Arg, 1< Attribute.t -> unit */ +CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) { + LLVMRemoveFunctionAttr(Arg, 1< Attribute.t -> unit */ +CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) { + LLVMAddAttribute(Arg, 1< Attribute.t -> unit */ +CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) { + LLVMRemoveAttribute(Arg, 1< 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 @@ CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) { 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 -> Attribute.t -> unit */ +CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr, + value index, + value PA) { + LLVMRemoveInstrAttribute(Instr, Int_val(index), 1< bool */ diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h index 3d5be532609..d2d88454d71 100644 --- a/include/llvm-c/Core.h +++ b/include/llvm-c/Core.h @@ -504,6 +504,8 @@ unsigned LLVMGetFunctionCallConv(LLVMValueRef Fn); 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); diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp index 962f7694927..1fa83ebd1c0 100644 --- a/lib/VMCore/Core.cpp +++ b/lib/VMCore/Core.cpp @@ -776,6 +776,20 @@ void LLVMSetGC(LLVMValueRef Fn, const char *GC) { F->clearGC(); } +void LLVMAddFunctionAttr(LLVMValueRef Fn, LLVMAttribute PA) { + Function *Func = unwrap(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(Fn); + const AttrListPtr PAL = Func->getAttributes(); + const AttrListPtr PALnew = PAL.removeAttr(0, PA); + Func->setAttributes(PALnew); +} + /*--.. Operations on parameters ............................................--*/ unsigned LLVMCountParams(LLVMValueRef FnRef) { diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index 82c917fcd76..5c3dd74dc2b 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -626,7 +626,13 @@ 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); insist (At_end f = param_succ p2); @@ -988,6 +994,10 @@ let test_builder () = 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); -- 2.34.1