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

3 files changed, 86 insertions, 33 deletions

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<<Int_val(PA));
+  LLVMAddFunctionAttr(Arg, 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));
+  LLVMRemoveFunctionAttr(Arg, Int_val(PA));
   return Val_unit;
 }
 /*--... Operations on parameters ...........................................--*/
@@ -968,13 +973,13 @@ CAMLprim value llvm_params(LLVMValueRef Fn, value Index) {
 
 /* llvalue -> Attribute.t -> unit */
 CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
-  LLVMAddAttribute(Arg, 1<<Int_val(PA));
+  LLVMAddAttribute(Arg, 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));
+  LLVMRemoveAttribute(Arg, Int_val(PA));
   return Val_unit;
 }
 
@@ -1042,7 +1047,7 @@ CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
 CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
                                                value index,
                                                value PA) {
-  LLVMAddInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
+  LLVMAddInstrAttribute(Instr, Int_val(index), Int_val(PA));
   return Val_unit;
 }
 
@@ -1050,7 +1055,7 @@ CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
 CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
                                                   value index,
                                                   value PA) {
-  LLVMRemoveInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
+  LLVMRemoveInstrAttribute(Instr, Int_val(index), Int_val(PA));
   return Val_unit;
 }