Add support for inserting inline asm to ocaml.

[oota-llvm.git] / bindings / ocaml / llvm / llvm_ocaml.c

diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 8868d07ffc7a317b8dcf723301def358153be0a6..000db05449485295e6aa7a63d7fecdba19e6d815 100644 (file)
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -110,11 +110,18 @@ CAMLprim LLVMContextRef llvm_global_context(value Unit) {
   return LLVMGetGlobalContext();
 }
 
+/* llcontext -> string -> int */
+CAMLprim value llvm_mdkind_id(LLVMContextRef C, value Name) {
+  unsigned MDKindID = LLVMGetMDKindIDInContext(C, String_val(Name),
+                                               caml_string_length(Name));
+  return Val_int(MDKindID);
+}
+
 /*===-- Modules -----------------------------------------------------------===*/
 
-/* string -> llmodule */
-CAMLprim LLVMModuleRef llvm_create_module(value ModuleID) {
-  return LLVMModuleCreateWithName(String_val(ModuleID));
+/* llcontext -> string -> llmodule */
+CAMLprim LLVMModuleRef llvm_create_module(LLVMContextRef C, value ModuleID) {
+  return LLVMModuleCreateWithNameInContext(String_val(ModuleID), C);
 }
 
 /* llmodule -> unit */
@@ -157,6 +164,18 @@ CAMLprim value llvm_delete_type_name(value Name, LLVMModuleRef M) {
   return Val_unit;
 }
 
+/* llmodule -> string -> lltype option */
+CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name) {
+  CAMLparam1(Name);
+  LLVMTypeRef T;
+  if ((T = LLVMGetTypeByName(M, String_val(Name)))) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) T;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 /* llmodule -> unit */
 CAMLprim value llvm_dump_module(LLVMModuleRef M) {
   LLVMDumpModule(M);
@@ -283,7 +302,7 @@ CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C,
 }
 
 /* lltype -> lltype array */
-CAMLprim value llvm_element_types(LLVMTypeRef StructTy) {
+CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) {
   value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
   LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys);
   return Tys;
@@ -294,6 +313,21 @@ CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) {
   return Val_bool(LLVMIsPackedStruct(StructTy));
 }
 
+/*--... Operations on union types ..........................................--*/
+
+/* llcontext -> lltype array -> lltype */
+CAMLprim LLVMTypeRef llvm_union_type(LLVMContextRef C, value ElementTypes) {
+  return LLVMUnionTypeInContext(C, (LLVMTypeRef *) ElementTypes,
+                                Wosize_val(ElementTypes));
+}
+
+/* lltype -> lltype array */
+CAMLprim value llvm_union_element_types(LLVMTypeRef UnionTy) {
+  value Tys = alloc(LLVMCountUnionElementTypes(UnionTy), 0);
+  LLVMGetUnionElementTypes(UnionTy, (LLVMTypeRef *) Tys);
+  return Tys;
+}
+
 /*--... Operations on array, pointer, and vector types .....................--*/
 
 /* lltype -> int -> lltype */
@@ -423,6 +457,52 @@ CAMLprim value llvm_is_undef(LLVMValueRef Val) {
   return Val_bool(LLVMIsUndef(Val));
 }
 
+/*--... Operations on instructions .........................................--*/
+
+/* llvalue -> bool */
+CAMLprim value llvm_has_metadata(LLVMValueRef Val) {
+  return Val_bool(LLVMHasMetadata(Val));
+}
+
+/* llvalue -> int -> llvalue option */
+CAMLprim value llvm_metadata(LLVMValueRef Val, value MDKindID) {
+  CAMLparam1(MDKindID);
+  LLVMValueRef MD;
+  if ((MD = LLVMGetMetadata(Val, Int_val(MDKindID)))) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) MD;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
+/* llvalue -> int -> llvalue -> unit */
+CAMLprim value llvm_set_metadata(LLVMValueRef Val, value MDKindID,
+                                 LLVMValueRef MD) {
+  LLVMSetMetadata(Val, Int_val(MDKindID), MD);
+  return Val_unit;
+}
+
+/* llvalue -> int -> unit */
+CAMLprim value llvm_clear_metadata(LLVMValueRef Val, value MDKindID) {
+  LLVMSetMetadata(Val, Int_val(MDKindID), NULL);
+  return Val_unit;
+}
+
+
+/*--... Operations on metadata .............................................--*/
+
+/* llcontext -> string -> llvalue */
+CAMLprim LLVMValueRef llvm_mdstring(LLVMContextRef C, value S) {
+  return LLVMMDStringInContext(C, String_val(S), caml_string_length(S));
+}
+
+/* llcontext -> llvalue array -> llvalue */
+CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) {
+  return LLVMMDNodeInContext(C, (LLVMValueRef*) Op_val(ElementVals),
+                             Wosize_val(ElementVals));
+}
+
 /*--... Operations on scalar constants .....................................--*/
 
 /* lltype -> int -> llvalue */
@@ -561,6 +641,14 @@ CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate,
   CAMLreturnT(LLVMValueRef, result);
 }
 
+/* lltype -> string -> string -> bool -> bool -> llvalue */
+CAMLprim LLVMValueRef llvm_const_inline_asm(LLVMTypeRef Ty, value Asm,
+                                     value Constraints, value HasSideEffects,
+                                     value IsAlignStack) {
+  return LLVMConstInlineAsm(Ty, String_val(Asm), String_val(Constraints),
+                            Bool_val(HasSideEffects), Bool_val(IsAlignStack));
+}
+
 /*--... Operations on global variables, functions, and aliases (globals) ...--*/
 
 /* llvalue -> bool */
@@ -629,6 +717,20 @@ CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
   return LLVMAddGlobal(M, Ty, String_val(Name));
 }
 
+/* lltype -> string -> int -> llmodule -> llvalue */
+CAMLprim LLVMValueRef llvm_declare_qualified_global(LLVMTypeRef Ty, value Name,
+                                                    value AddressSpace,
+                                                    LLVMModuleRef M) {
+  LLVMValueRef GlobalVar;
+  if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
+    if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
+      return LLVMConstBitCast(GlobalVar,
+                              LLVMPointerType(Ty, Int_val(AddressSpace)));
+    return GlobalVar;
+  }
+  return LLVMAddGlobal(M, Ty, String_val(Name));
+}
+
 /* string -> llmodule -> llvalue option */
 CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
   CAMLparam1(Name);
@@ -650,6 +752,19 @@ CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
   return GlobalVar;
 }
 
+/* string -> llvalue -> int -> llmodule -> llvalue */
+CAMLprim LLVMValueRef llvm_define_qualified_global(value Name,
+                                                   LLVMValueRef Initializer,
+                                                   value AddressSpace,
+                                                   LLVMModuleRef M) {
+  LLVMValueRef GlobalVar = LLVMAddGlobalInAddressSpace(M,
+                                                       LLVMTypeOf(Initializer),
+                                                       String_val(Name),
+                                                       Int_val(AddressSpace));
+  LLVMSetInitializer(GlobalVar, Initializer);
+  return GlobalVar;
+}
+
 /* llvalue -> unit */
 CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) {
   LLVMDeleteGlobal(GlobalVar);
@@ -978,7 +1093,7 @@ CAMLprim value llvm_position_builder(value Pos, value B) {
 }
 
 /* llbuilder -> llbasicblock */
-CAMLprim LLVMBasicBlockRef llvm_insertion_block(LLVMBuilderRef B) {
+CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) {
   LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
   if (!InsertBlock)
     raise_not_found();
@@ -986,12 +1101,44 @@ CAMLprim LLVMBasicBlockRef llvm_insertion_block(LLVMBuilderRef B) {
 }
 
 /* llvalue -> string -> llbuilder -> unit */
-CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name,
-                                               LLVMBuilderRef B) {
-  LLVMInsertIntoBuilderWithName(B, I, String_val(Name));
+CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) {
+  LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name));
+  return Val_unit;
+}
+
+/*--... Metadata ...........................................................--*/
+
+/* llbuilder -> llvalue -> unit */
+CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) {
+  LLVMSetCurrentDebugLocation(Builder_val(B), V);
+  return Val_unit;
+}
+
+/* llbuilder -> unit */
+CAMLprim value llvm_clear_current_debug_location(value B) {
+  LLVMSetCurrentDebugLocation(Builder_val(B), NULL);
   return Val_unit;
 }
 
+/* llbuilder -> llvalue option */
+CAMLprim value llvm_current_debug_location(value B) {
+  CAMLparam0();
+  LLVMValueRef L;
+  if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) L;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
+/* llbuilder -> llvalue -> unit */
+CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) {
+  LLVMSetInstDebugLocation(Builder_val(B), V);
+  return Val_unit;
+}
+
+
 /*--... Terminators ........................................................--*/
 
 /* llbuilder -> llvalue */
@@ -1031,13 +1178,27 @@ CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
   return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
 }
 
-CAMLprim value llvm_add_case(LLVMValueRef Switch,
-                             LLVMValueRef OnVal,
+/* llvalue -> llvalue -> llbasicblock -> unit */
+CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
                              LLVMBasicBlockRef Dest) {
   LLVMAddCase(Switch, OnVal, Dest);
   return Val_unit;
 }
 
+/* llvalue -> llbasicblock -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr,
+                                             value EstimatedDests,
+                                             value B) {
+  return LLVMBuildIndirectBr(Builder_val(B), Addr, EstimatedDests);
+}
+
+/* llvalue -> llvalue -> llbasicblock -> unit */
+CAMLprim value llvm_add_destination(LLVMValueRef IndirectBr,
+                                    LLVMBasicBlockRef Dest) {
+  LLVMAddDestination(IndirectBr, Dest);
+  return Val_unit;
+}
+
 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
    llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
@@ -1081,6 +1242,12 @@ CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS,
   return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name));
 }
 
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_nuw_add(LLVMValueRef LHS, LLVMValueRef RHS,
+                                         value Name, value B) {
+  return LLVMBuildNUWAdd(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS,
                                       value Name, value B) {
@@ -1093,6 +1260,18 @@ CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS,
   return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name));
 }
 
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_nsw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
+                                         value Name, value B) {
+  return LLVMBuildNSWSub(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_nuw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
+                                         value Name, value B) {
+  return LLVMBuildNUWSub(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS,
                                       value Name, value B) {
@@ -1105,6 +1284,18 @@ CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS,
   return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name));
 }
 
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_nsw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
+                                         value Name, value B) {
+  return LLVMBuildNSWMul(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_nuw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
+                                         value Name, value B) {
+  return LLVMBuildNUWMul(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS,
                                       value Name, value B) {
@@ -1196,25 +1387,31 @@ CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X,
 }
 
 /* llvalue -> string -> llbuilder -> llvalue */
-CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X,
-                                     value Name, value B) {
-  return LLVMBuildNot(Builder_val(B), X, String_val(Name));
+CAMLprim LLVMValueRef llvm_build_nsw_neg(LLVMValueRef X,
+                                         value Name, value B) {
+  return LLVMBuildNSWNeg(Builder_val(B), X, String_val(Name));
 }
 
-/*--... Memory .............................................................--*/
+/* llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_nuw_neg(LLVMValueRef X,
+                                         value Name, value B) {
+  return LLVMBuildNUWNeg(Builder_val(B), X, String_val(Name));
+}
 
-/* lltype -> string -> llbuilder -> llvalue */
-CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty,
-                                        value Name, value B) {
-  return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
+/* llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_fneg(LLVMValueRef X,
+                                     value Name, value B) {
+  return LLVMBuildFNeg(Builder_val(B), X, String_val(Name));
 }
 
-/* lltype -> llvalue -> string -> llbuilder -> llvalue */
-CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty, LLVMValueRef Size,
-                                              value Name, value B) {
-  return LLVMBuildArrayMalloc(Builder_val(B), Ty, Size, String_val(Name));
+/* llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X,
+                                     value Name, value B) {
+  return LLVMBuildNot(Builder_val(B), X, String_val(Name));
 }
 
+/*--... Memory .............................................................--*/
+
 /* lltype -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty,
                                         value Name, value B) {
@@ -1227,11 +1424,6 @@ CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size,
   return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name));
 }
 
-/* llvalue -> llbuilder -> llvalue */
-CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef Pointer, value B) {
-  return LLVMBuildFree(Builder_val(B), Pointer);
-}
-
 /* llvalue -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer,
                                       value Name, value B) {
@@ -1263,11 +1455,10 @@ CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer,
 
 /* llvalue -> int -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer,
-                                               value Indices, value Name,
+                                               value Index, value Name,
                                                value B) {
-  return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
-                              (LLVMValueRef *) Op_val(Indices),
-                              Wosize_val(Indices), String_val(Name));
+  return LLVMBuildStructGEP(Builder_val(B), Pointer,
+                              Int_val(Index), String_val(Name));
 }
 
 /* string -> string -> llbuilder -> llvalue */