Add support for inserting inline asm to ocaml.

[oota-llvm.git] / bindings / ocaml / llvm / llvm.ml

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 4539098aa0725da22f3044ed426f7eec99e8aa3b..92bfef51d0318d6b15aa7a426aef81ab4a0cf98e 100644 (file)
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -35,6 +35,7 @@ module TypeKind = struct
   | Opaque
   | Vector
   | Metadata
+  | Union
 end
 
 module Linkage = struct
@@ -93,6 +94,7 @@ module Attribute = struct
   | Noredzone
   | Noimplicitfloat
   | Naked
+  | Inlinehint
 end
 
 module Icmp = struct
@@ -146,6 +148,7 @@ type ('a, 'b) llrev_pos =
 external create_context : unit -> llcontext = "llvm_create_context"
 external dispose_context : llcontext -> unit = "llvm_dispose_context"
 external global_context : unit -> llcontext = "llvm_global_context"
+external mdkind_id : llcontext -> string -> int = "llvm_mdkind_id"
 
 (*===-- Modules -----------------------------------------------------------===*)
 external create_module : llcontext -> string -> llmodule = "llvm_create_module"
@@ -162,6 +165,8 @@ external define_type_name : string -> lltype -> llmodule -> bool
                           = "llvm_add_type_name"
 external delete_type_name : string -> llmodule -> unit
                           = "llvm_delete_type_name"
+external type_by_name : llmodule -> string -> lltype option
+                      = "llvm_type_by_name"
 external dump_module : llmodule -> unit = "llvm_dump_module"
 
 (*===-- Types -------------------------------------------------------------===*)
@@ -197,9 +202,15 @@ external param_types : lltype -> lltype array = "llvm_param_types"
 external struct_type : llcontext -> lltype array -> lltype = "llvm_struct_type"
 external packed_struct_type : llcontext -> lltype array -> lltype
                             = "llvm_packed_struct_type"
-external element_types : lltype -> lltype array = "llvm_element_types"
+external struct_element_types : lltype -> lltype array
+                              = "llvm_struct_element_types"
 external is_packed : lltype -> bool = "llvm_is_packed"
 
+(*--... Operations on union types ..........................................--*)
+external union_type : llcontext -> lltype array -> lltype = "llvm_union_type"
+external union_element_types : lltype -> lltype array
+                             = "llvm_union_element_types"
+
 (*--... Operations on pointer, vector, and array types .....................--*)
 external array_type : lltype -> int -> lltype = "llvm_array_type"
 external pointer_type : lltype -> lltype = "llvm_pointer_type"
@@ -228,15 +239,28 @@ external type_of : llvalue -> lltype = "llvm_type_of"
 external value_name : llvalue -> string = "llvm_value_name"
 external set_value_name : string -> llvalue -> unit = "llvm_set_value_name"
 external dump_value : llvalue -> unit = "llvm_dump_value"
+external replace_all_uses_with : llvalue -> llvalue -> unit
+                               = "LLVMReplaceAllUsesWith"
 
 (*--... Operations on constants of (mostly) any type .......................--*)
 external is_constant : llvalue -> bool = "llvm_is_constant"
 external const_null : lltype -> llvalue = "LLVMConstNull"
 external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes"
+external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull"
 external undef : lltype -> llvalue = "LLVMGetUndef"
 external is_null : llvalue -> bool = "llvm_is_null"
 external is_undef : llvalue -> bool = "llvm_is_undef"
 
+(*--... Operations on instructions .........................................--*)
+external has_metadata : llvalue -> bool = "llvm_has_metadata"
+external metadata : llvalue -> int -> llvalue option = "llvm_metadata"
+external set_metadata : llvalue -> int -> llvalue -> unit = "llvm_set_metadata"
+external clear_metadata : llvalue -> int -> unit = "llvm_clear_metadata"
+
+(*--... Operations on metadata .......,.....................................--*)
+external mdstring : llcontext -> string -> llvalue = "llvm_mdstring"
+external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode"
+
 (*--... Operations on scalar constants .....................................--*)
 external const_int : lltype -> int -> llvalue = "llvm_const_int"
 external const_of_int64 : lltype -> Int64.t -> bool -> llvalue
@@ -256,19 +280,27 @@ external const_struct : llcontext -> llvalue array -> llvalue
 external const_packed_struct : llcontext -> llvalue array -> llvalue
                              = "llvm_const_packed_struct"
 external const_vector : llvalue array -> llvalue = "llvm_const_vector"
+external const_union : lltype -> llvalue -> llvalue = "LLVMConstUnion"
 
 (*--... Constant expressions ...............................................--*)
 external align_of : lltype -> llvalue = "LLVMAlignOf"
 external size_of : lltype -> llvalue = "LLVMSizeOf"
 external const_neg : llvalue -> llvalue = "LLVMConstNeg"
+external const_nsw_neg : llvalue -> llvalue = "LLVMConstNSWNeg"
+external const_nuw_neg : llvalue -> llvalue = "LLVMConstNUWNeg"
 external const_fneg : llvalue -> llvalue = "LLVMConstFNeg"
 external const_not : llvalue -> llvalue = "LLVMConstNot"
 external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd"
 external const_nsw_add : llvalue -> llvalue -> llvalue = "LLVMConstNSWAdd"
+external const_nuw_add : llvalue -> llvalue -> llvalue = "LLVMConstNUWAdd"
 external const_fadd : llvalue -> llvalue -> llvalue = "LLVMConstFAdd"
 external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub"
+external const_nsw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNSWSub"
+external const_nuw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNUWSub"
 external const_fsub : llvalue -> llvalue -> llvalue = "LLVMConstFSub"
 external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul"
+external const_nsw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNSWMul"
+external const_nuw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNUWMul"
 external const_fmul : llvalue -> llvalue -> llvalue = "LLVMConstFMul"
 external const_udiv : llvalue -> llvalue -> llvalue = "LLVMConstUDiv"
 external const_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstSDiv"
@@ -324,6 +356,10 @@ external const_extractvalue : llvalue -> int array -> llvalue
                             = "llvm_const_extractvalue"
 external const_insertvalue : llvalue -> llvalue -> int array -> llvalue
                            = "llvm_const_insertvalue"
+external const_inline_asm : lltype -> string -> string -> bool -> bool ->
+                            llvalue
+                          = "llvm_const_inline_asm"
+external block_address : llvalue -> llbasicblock -> llvalue = "LLVMBlockAddress"
 
 (*--... Operations on global variables, functions, and aliases (globals) ...--*)
 external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent"
@@ -343,8 +379,14 @@ external set_global_constant : bool -> llvalue -> unit
 (*--... Operations on global variables .....................................--*)
 external declare_global : lltype -> string -> llmodule -> llvalue
                         = "llvm_declare_global"
+external declare_qualified_global : lltype -> string -> int -> llmodule ->
+                                    llvalue
+                                  = "llvm_declare_qualified_global"
 external define_global : string -> llvalue -> llmodule -> llvalue
                        = "llvm_define_global"
+external define_qualified_global : string -> llvalue -> int -> llmodule ->
+                                   llvalue
+                                 = "llvm_define_qualified_global"
 external lookup_global : string -> llmodule -> llvalue option
                        = "llvm_lookup_global"
 external delete_global : llvalue -> unit = "llvm_delete_global"
@@ -679,6 +721,17 @@ let position_before i = position_builder (Before i)
 let position_at_end bb = position_builder (At_end bb)
 
 
+(*--... Metadata ...........................................................--*)
+external set_current_debug_location : llbuilder -> llvalue -> unit
+                                    = "llvm_set_current_debug_location"
+external clear_current_debug_location : llbuilder -> unit
+                                      = "llvm_clear_current_debug_location"
+external current_debug_location : llbuilder -> llvalue option
+                                    = "llvm_current_debug_location"
+external set_inst_debug_location : llbuilder -> llvalue -> unit
+                                 = "llvm_set_inst_debug_location"
+
+
 (*--... Terminators ........................................................--*)
 external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void"
 external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret"
@@ -691,6 +744,10 @@ external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
                       = "llvm_build_switch"
 external add_case : llvalue -> llvalue -> llbasicblock -> unit
                   = "llvm_add_case"
+external build_indirect_br : llvalue -> int -> llbuilder -> llvalue
+                           = "llvm_build_indirect_br"
+external add_destination : llvalue -> llbasicblock -> unit
+                         = "llvm_add_destination"
 external build_invoke : llvalue -> llvalue array -> llbasicblock ->
                         llbasicblock -> string -> llbuilder -> llvalue
                       = "llvm_build_invoke_bc" "llvm_build_invoke_nat"
@@ -702,14 +759,24 @@ external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue
                    = "llvm_build_add"
 external build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue
                        = "llvm_build_nsw_add"
+external build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue
+                       = "llvm_build_nuw_add"
 external build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue
                     = "llvm_build_fadd"
 external build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue
                    = "llvm_build_sub"
+external build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue
+                       = "llvm_build_nsw_sub"
+external build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue
+                       = "llvm_build_nuw_sub"
 external build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue
                     = "llvm_build_fsub"
 external build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue
                    = "llvm_build_mul"
+external build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue
+                       = "llvm_build_nsw_mul"
+external build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue
+                       = "llvm_build_nuw_mul"
 external build_fmul : llvalue -> llvalue -> string -> llbuilder -> llvalue
                     = "llvm_build_fmul"
 external build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue
@@ -740,19 +807,20 @@ external build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue
                    = "llvm_build_xor"
 external build_neg : llvalue -> string -> llbuilder -> llvalue
                    = "llvm_build_neg"
+external build_nsw_neg : llvalue -> string -> llbuilder -> llvalue
+                       = "llvm_build_nsw_neg"
+external build_nuw_neg : llvalue -> string -> llbuilder -> llvalue
+                       = "llvm_build_nuw_neg"
+external build_fneg : llvalue -> string -> llbuilder -> llvalue
+                    = "llvm_build_fneg"
 external build_not : llvalue -> string -> llbuilder -> llvalue
                    = "llvm_build_not"
 
 (*--... Memory .............................................................--*)
-external build_malloc : lltype -> string -> llbuilder -> llvalue
-                      = "llvm_build_malloc"
-external build_array_malloc : lltype -> llvalue -> string -> llbuilder ->
-                              llvalue = "llvm_build_array_malloc"
 external build_alloca : lltype -> string -> llbuilder -> llvalue
                       = "llvm_build_alloca"
 external build_array_alloca : lltype -> llvalue -> string -> llbuilder ->
                               llvalue = "llvm_build_array_alloca"
-external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free"
 external build_load : llvalue -> string -> llbuilder -> llvalue
                     = "llvm_build_load"
 external build_store : llvalue -> llvalue -> llbuilder -> llvalue
@@ -896,11 +964,14 @@ let rec string_of_lltype ty =
   | TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*"
   | TypeKind.Struct ->
       let s = "{ " ^ (concat2 ", " (
-                Array.map string_of_lltype (element_types ty)
+                Array.map string_of_lltype (struct_element_types ty)
               )) ^ " }" in
       if is_packed ty
         then "<" ^ s ^ ">"
         else s
+  | TypeKind.Union -> "union { " ^ (concat2 ", " (
+                        Array.map string_of_lltype (union_element_types ty)
+                      )) ^ " }"
   | TypeKind.Array -> "["   ^ (string_of_int (array_length ty)) ^
                       " x " ^ (string_of_lltype (element_type ty)) ^ "]"
   | TypeKind.Vector -> "<"   ^ (string_of_int (vector_size ty)) ^