From 0941534c712d77243d9dda5e8c1d927563b4edff Mon Sep 17 00:00:00 2001 From: Chris Lattner Date: Sat, 10 Apr 2010 17:52:58 +0000 Subject: add attributes and module level asm to the ocaml bindings, patch by Patrick Walton! git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@100932 91177308-0d34-0410-b5e6-96231b3b80d8 --- bindings/ocaml/llvm/llvm.ml | 76 ++++++++++++++++++++++++++++++++-------- bindings/ocaml/llvm/llvm.mli | 26 +++++++------- bindings/ocaml/llvm/llvm_ocaml.c | 17 +++++---- 3 files changed, 86 insertions(+), 33 deletions(-) (limited to 'bindings/ocaml/llvm') diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index e801c49..7ab6f51 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -90,13 +90,13 @@ module Attribute = struct | Optsize | Ssp | Sspreq - | Alignment + | Alignment of int | Nocapture | Noredzone | Noimplicitfloat | Naked | Inlinehint - | Stackalignment + | Stackalignment of int end module Icmp = struct @@ -170,6 +170,8 @@ external delete_type_name : string -> llmodule -> unit external type_by_name : llmodule -> string -> lltype option = "llvm_type_by_name" external dump_module : llmodule -> unit = "llvm_dump_module" +external set_module_inline_asm : llmodule -> string -> unit + = "llvm_set_module_inline_asm" (*===-- Types -------------------------------------------------------------===*) external classify_type : lltype -> TypeKind.t = "llvm_classify_type" @@ -548,10 +550,42 @@ 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 add_function_attr : llvalue -> Attribute.t -> unit - = "llvm_add_function_attr" -external remove_function_attr : llvalue -> Attribute.t -> unit - = "llvm_remove_function_attr" +external llvm_add_function_attr : llvalue -> int -> unit + = "llvm_add_function_attr" +external llvm_remove_function_attr : llvalue -> int -> unit + = "llvm_remove_function_attr" + +let pack_attr (attr:Attribute.t) : int = + match attr with + Attribute.Zext -> 1 lsl 0 + | Attribute.Sext -> 1 lsl 1 + | Attribute.Noreturn -> 1 lsl 2 + | Attribute.Inreg -> 1 lsl 3 + | Attribute.Structret -> 1 lsl 4 + | Attribute.Nounwind -> 1 lsl 5 + | Attribute.Noalias -> 1 lsl 6 + | Attribute.Byval -> 1 lsl 7 + | Attribute.Nest -> 1 lsl 8 + | Attribute.Readnone -> 1 lsl 9 + | Attribute.Readonly -> 1 lsl 10 + | Attribute.Noinline -> 1 lsl 11 + | Attribute.Alwaysinline -> 1 lsl 12 + | Attribute.Optsize -> 1 lsl 13 + | Attribute.Ssp -> 1 lsl 14 + | Attribute.Sspreq -> 1 lsl 15 + | Attribute.Alignment n -> n lsl 16 + | Attribute.Nocapture -> 1 lsl 21 + | Attribute.Noredzone -> 1 lsl 22 + | Attribute.Noimplicitfloat -> 1 lsl 23 + | Attribute.Naked -> 1 lsl 24 + | Attribute.Inlinehint -> 1 lsl 25 + | Attribute.Stackalignment n -> n lsl 26 + +let add_function_attr llval attr = + llvm_add_function_attr llval (pack_attr attr) + +let remove_function_attr llval attr = + llvm_remove_function_attr llval (pack_attr attr) (*--... Operations on params ...............................................--*) external params : llvalue -> llvalue array = "llvm_params" @@ -602,10 +636,17 @@ 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 llvm_add_param_attr : llvalue -> int -> unit + = "llvm_add_param_attr" +external llvm_remove_param_attr : llvalue -> int -> 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" @@ -727,10 +768,17 @@ 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" + +external llvm_add_instruction_param_attr : llvalue -> int -> int -> unit + = "llvm_add_instruction_param_attr" +external llvm_remove_instruction_param_attr : llvalue -> int -> int -> 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) (*--... 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 4b0c06d..742265c 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -139,13 +139,13 @@ module Attribute : sig | Optsize | Ssp | Sspreq - | Alignment + | Alignment of int | Nocapture | Noredzone | Noimplicitfloat | Naked | Inlinehint - | Stackalignment + | Stackalignment of int end (** The predicate for an integer comparison ([icmp]) instruction. @@ -284,6 +284,11 @@ external type_by_name : llmodule -> string -> lltype option error. See the method [llvm::Module::dump]. *) external dump_module : llmodule -> unit = "llvm_dump_module" +(** [set_module_inline_asm m asm] sets the inline assembler for the module. See + the method [llvm::Module::setModuleInlineAsm]. *) +external set_module_inline_asm : llmodule -> string -> unit + = "llvm_set_module_inline_asm" + (** {6 Types} *) @@ -1282,13 +1287,11 @@ 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" +val add_function_attr : llvalue -> Attribute.t -> unit (** [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" +val remove_function_attr : llvalue -> Attribute.t -> unit (** {7 Operations on params} *) @@ -1343,11 +1346,10 @@ val rev_iter_params : (llvalue -> unit) -> llvalue -> unit 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" +val add_param_attr : llvalue -> Attribute.t -> unit (** [remove_param_attr p a] removes attribute [a] from parameter [p]. *) -external remove_param_attr : llvalue -> Attribute.t -> unit - = "llvm_remove_param_attr" +val remove_param_attr : llvalue -> Attribute.t -> unit (** [set_param_alignment p a] set the alignment of parameter [p] to [a]. *) external set_param_alignment : llvalue -> int -> unit @@ -1499,14 +1501,12 @@ external 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. *) -external add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit - = "llvm_add_instruction_param_attr" +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. *) -external remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit - = "llvm_remove_instruction_param_attr" +val remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit (** {Operations on call instructions (only)} *) diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index d526a05..c4355ba 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -182,6 +182,11 @@ CAMLprim value llvm_dump_module(LLVMModuleRef M) { return Val_unit; } +/* llmodule -> string -> unit */ +CAMLprim value llvm_set_module_inline_asm(LLVMModuleRef M, value Asm) { + LLVMSetModuleInlineAsm(M, String_val(Asm)); + return Val_unit; +} /*===-- Types -------------------------------------------------------------===*/ @@ -941,13 +946,13 @@ CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) { /* 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<