[OCaml] Fix ABI incompatibility

[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 be6e808d73318d23374fdae623091caff017a75c..80fa8c3670da9ea800efdab9c0115ae33593913a 100644 (file)
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -1,4 +1,4 @@
-/*===-- llvm_ocaml.c - LLVM Ocaml Glue --------------------------*- C++ -*-===*\
+/*===-- llvm_ocaml.c - LLVM OCaml Glue --------------------------*- C++ -*-===*\
 |*                                                                            *|
 |*                     The LLVM Compiler Infrastructure                       *|
 |*                                                                            *|
@@ -7,7 +7,7 @@
 |*                                                                            *|
 |*===----------------------------------------------------------------------===*|
 |*                                                                            *|
-|* This file glues LLVM's ocaml interface to its C interface. These functions *|
+|* This file glues LLVM's OCaml interface to its C interface. These functions *|
 |* are by and large transparent wrappers to the corresponding C functions.    *|
 |*                                                                            *|
 |* Note that these functions intentionally take liberties with the CAMLparamX *|
@@ -21,7 +21,6 @@
 #include "caml/memory.h"
 #include "caml/fail.h"
 #include "caml/callback.h"
-#include "llvm/Config/config.h"
 #include <assert.h>
 #include <stdlib.h>
 #include <string.h>
@@ -387,6 +386,18 @@ CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
   return LLVMLabelTypeInContext(Context);
 }
 
+CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
+{
+  CAMLparam1(Name);
+  LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
+  if (Ty) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) Ty;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 /*===-- VALUES ------------------------------------------------------------===*/
 
 /* llvalue -> lltype */
@@ -474,6 +485,13 @@ CAMLprim value llvm_dump_value(LLVMValueRef Val) {
   return Val_unit;
 }
 
+/* llvalue -> llvalue -> unit */
+CAMLprim value llvm_replace_all_uses_with(LLVMValueRef OldVal,
+                                          LLVMValueRef NewVal) {
+  LLVMReplaceAllUsesWith(OldVal, NewVal);
+  return Val_unit;
+}
+
 /*--... Operations on users ................................................--*/
 
 /* llvalue -> int -> llvalue */
@@ -1034,15 +1052,22 @@ CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
   return Val_unit;
 }
 
-/* llvalue -> Attribute.t -> unit */
+/* llvalue -> int32 -> unit */
 CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
-  LLVMAddFunctionAttr(Arg, Int_val(PA));
+  LLVMAddFunctionAttr(Arg, Int32_val(PA));
   return Val_unit;
 }
 
-/* llvalue -> Attribute.t -> unit */
+/* llvalue -> int32 */
+CAMLprim value llvm_function_attr(LLVMValueRef Fn)
+{
+    CAMLparam0();
+    CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
+}
+
+/* llvalue -> int32 -> unit */
 CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
-  LLVMRemoveFunctionAttr(Arg, Int_val(PA));
+  LLVMRemoveFunctionAttr(Arg, Int32_val(PA));
   return Val_unit;
 }
 /*--... Operations on parameters ...........................................--*/
@@ -1054,6 +1079,13 @@ CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
   return LLVMGetParam(Fn, Int_val(Index));
 }
 
+/* llvalue -> int */
+CAMLprim value llvm_param_attr(LLVMValueRef Param)
+{
+    CAMLparam0();
+    CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
+}
+
 /* llvalue -> llvalue */
 CAMLprim value llvm_params(LLVMValueRef Fn) {
   value Params = alloc(LLVMCountParams(Fn), 0);
@@ -1061,15 +1093,15 @@ CAMLprim value llvm_params(LLVMValueRef Fn) {
   return Params;
 }
 
-/* llvalue -> Attribute.t -> unit */
+/* llvalue -> int32 -> unit */
 CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
-  LLVMAddAttribute(Arg, Int_val(PA));
+  LLVMAddAttribute(Arg, Int32_val(PA));
   return Val_unit;
 }
 
-/* llvalue -> Attribute.t -> unit */
+/* llvalue -> int32 -> unit */
 CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
-  LLVMRemoveAttribute(Arg, Int_val(PA));
+  LLVMRemoveAttribute(Arg, Int32_val(PA));
   return Val_unit;
 }
 
@@ -1084,6 +1116,19 @@ CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
 DEFINE_ITERATORS(
   block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
 
+/* llbasicblock -> llvalue option */
+CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
+{
+  CAMLparam0();
+  LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
+  if (Term) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) Term;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 /* llvalue -> llbasicblock array */
 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
   value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
@@ -1125,7 +1170,7 @@ CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
   if (!LLVMIsAInstruction(Inst))
       failwith("Not an instruction");
   o = LLVMGetInstructionOpcode(Inst);
-  assert (o <= LLVMUnwind );
+  assert (o <= LLVMLandingPad);
   return Val_int(o);
 }
 
@@ -1155,19 +1200,19 @@ CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
   return Val_unit;
 }
 
-/* llvalue -> int -> Attribute.t -> unit */
+/* llvalue -> int -> int32 -> unit */
 CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
                                                value index,
                                                value PA) {
-  LLVMAddInstrAttribute(Instr, Int_val(index), Int_val(PA));
+  LLVMAddInstrAttribute(Instr, Int_val(index), Int32_val(PA));
   return Val_unit;
 }
 
-/* llvalue -> int -> Attribute.t -> unit */
+/* llvalue -> int -> int32 -> unit */
 CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
                                                   value index,
                                                   value PA) {
-  LLVMRemoveInstrAttribute(Instr, Int_val(index), Int_val(PA));
+  LLVMRemoveInstrAttribute(Instr, Int_val(index), Int32_val(PA));
   return Val_unit;
 }
 
@@ -1218,6 +1263,11 @@ CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
   CAMLreturn(Tl);
 }
 
+/* llvalue -> unit */
+CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
+  LLVMInstructionEraseFromParent(Instruction);
+  return Val_unit;
+}
 
 /*===-- Instruction builders ----------------------------------------------===*/
 
@@ -1234,6 +1284,9 @@ static struct custom_operations builder_ops = {
   custom_hash_default,
   custom_serialize_default,
   custom_deserialize_default
+#ifdef custom_compare_ext_default
+  , custom_compare_ext_default
+#endif
 };
 
 static value alloc_builder(LLVMBuilderRef B) {
@@ -1345,6 +1398,27 @@ CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
   return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
 }
 
+/* lltype -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
+                                        value B)
+{
+  return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
+}
+
+/* lltype -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
+                                              LLVMValueRef Val,
+                                              value Name, value B)
+{
+  return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
+}
+
+/* llvalue -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
+{
+  return LLVMBuildFree(Builder_val(B), P);
+}
+
 /* llvalue -> llvalue -> llbasicblock -> unit */
 CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
                              LLVMBasicBlockRef Dest) {
@@ -1385,6 +1459,7 @@ CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
                                Args[4], Args[5]);
 }
 
+/* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
                                             value NumClauses,  value Name,
                                             value B) {
@@ -1392,12 +1467,27 @@ CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
                                String_val(Name));
 }
 
+/* llvalue -> llvalue -> unit */
+CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
+{
+    LLVMAddClause(LandingPadInst, ClauseVal);
+    return Val_unit;
+}
+
+
+/* llvalue -> bool -> unit */
 CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
 {
     LLVMSetCleanup(LandingPadInst, Bool_val(flag));
     return Val_unit;
 }
 
+/* llvalue -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
+{
+    return LLVMBuildResume(Builder_val(B), Exn);
+}
+
 /* llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
   return LLVMBuildUnreachable(Builder_val(B));