X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=blobdiff_plain;f=bindings%2Focaml%2Fllvm%2Fllvm_ocaml.c;h=21519d474dfccfd682311b25fca01701e34efaa7;hp=d97523d60c62703b703a0dcb7fa66c39cc135904;hb=31116410de16f435d8c76c53e3d6b95fa812cd2c;hpb=8e130b1d0d53346e05d0a1161a52c6d62de163c4

diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index d97523d60c6..21519d474df 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -24,6 +24,7 @@
 #include "llvm/Config/config.h"
 #include <assert.h>
 #include <stdlib.h>
+#include <string.h>
 
 
 /* Can't use the recommended caml_named_value mechanism for backwards
@@ -152,24 +153,17 @@ CAMLprim value llvm_set_data_layout(value Layout, LLVMModuleRef M) {
   return Val_unit;
 }
 
-/* string -> lltype -> llmodule -> bool */
-CAMLprim value llvm_add_type_name(value Name, LLVMTypeRef Ty, LLVMModuleRef M) {
-  int res = LLVMAddTypeName(M, String_val(Name), Ty);
-  return Val_bool(res == 0);
-}
-
-/* string -> llmodule -> unit */
-CAMLprim value llvm_delete_type_name(value Name, LLVMModuleRef M) {
-  LLVMDeleteTypeName(M, String_val(Name));
-  return Val_unit;
-}
-
 /* llmodule -> unit */
 CAMLprim value llvm_dump_module(LLVMModuleRef M) {
   LLVMDumpModule(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 -------------------------------------------------------------===*/
 
@@ -178,6 +172,10 @@ CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
   return Val_int(LLVMGetTypeKind(Ty));
 }
 
+CAMLprim value llvm_type_is_sized(LLVMTypeRef Ty) {
+    return Val_bool(LLVMTypeIsSized(Ty));
+}
+
 /* lltype -> llcontext */
 CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) {
   return LLVMGetTypeContext(Ty);
@@ -247,6 +245,11 @@ CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) {
   return LLVMPPCFP128TypeInContext(Context);
 }
 
+/* llcontext -> lltype */
+CAMLprim LLVMTypeRef llvm_x86mmx_type(LLVMContextRef Context) {
+  return LLVMX86MMXTypeInContext(Context);
+}
+
 /*--... Operations on function types .......................................--*/
 
 /* lltype -> lltype array -> lltype */
@@ -289,6 +292,20 @@ CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C,
                                  Wosize_val(ElementTypes), 1);
 }
 
+/* lltype -> string option */
+CAMLprim value llvm_struct_name(LLVMTypeRef Ty)
+{
+  CAMLparam0();
+  const char *C = LLVMGetStructName(Ty);
+  if (C) {
+    CAMLlocal1(result);
+    result = caml_alloc_small(1, 0);
+    Store_field(result, 0, caml_copy_string(C));
+    CAMLreturn(result);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 /* lltype -> lltype array */
 CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) {
   value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
@@ -301,21 +318,6 @@ 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 */
@@ -366,44 +368,6 @@ CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
   return LLVMLabelTypeInContext(Context);
 }
 
-/* llcontext -> lltype */
-CAMLprim LLVMTypeRef llvm_opaque_type(LLVMContextRef Context) {
-  return LLVMOpaqueTypeInContext(Context);
-}
-
-/*--... Operations on type handles .........................................--*/
-
-#define Typehandle_val(v)  (*(LLVMTypeHandleRef *)(Data_custom_val(v)))
-
-static void llvm_finalize_handle(value TH) {
-  LLVMDisposeTypeHandle(Typehandle_val(TH));
-}
-
-static struct custom_operations typehandle_ops = {
-  (char *) "LLVMTypeHandle",
-  llvm_finalize_handle,
-  custom_compare_default,
-  custom_hash_default,
-  custom_serialize_default,
-  custom_deserialize_default
-};
-
-CAMLprim value llvm_handle_to_type(LLVMTypeRef PATy) {
-  value TH = alloc_custom(&typehandle_ops, sizeof(LLVMBuilderRef), 0, 1);
-  Typehandle_val(TH) = LLVMCreateTypeHandle(PATy);
-  return TH;
-}
-
-CAMLprim LLVMTypeRef llvm_type_of_handle(value TH) {
-  return LLVMResolveTypeHandle(Typehandle_val(TH));
-}
-
-CAMLprim value llvm_refine_type(LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy){
-  LLVMRefineType(AbstractTy, ConcreteTy);
-  return Val_unit;
-}
-
-
 /*===-- VALUES ------------------------------------------------------------===*/
 
 /* llvalue -> lltype */
@@ -428,6 +392,24 @@ CAMLprim value llvm_dump_value(LLVMValueRef Val) {
   return Val_unit;
 }
 
+/*--... Operations on users ................................................--*/
+
+/* llvalue -> int -> llvalue */
+CAMLprim LLVMValueRef llvm_operand(LLVMValueRef V, value I) {
+  return LLVMGetOperand(V, Int_val(I));
+}
+
+/* llvalue -> int -> llvalue -> unit */
+CAMLprim value llvm_set_operand(LLVMValueRef U, value I, LLVMValueRef V) {
+  LLVMSetOperand(U, Int_val(I), V);
+  return Val_unit;
+}
+
+/* llvalue -> int */
+CAMLprim value llvm_num_operands(LLVMValueRef V) {
+  return Val_int(LLVMGetNumOperands(V));
+}
+
 /*--... Operations on constants of (mostly) any type .......................--*/
 
 /* llvalue -> bool */
@@ -491,6 +473,32 @@ CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) {
                              Wosize_val(ElementVals));
 }
 
+/* llvalue -> string option */
+CAMLprim value llvm_get_mdstring(LLVMValueRef V) {
+  CAMLparam0();
+  const char *S;
+  unsigned Len;
+
+  if ((S = LLVMGetMDString(V, &Len))) {
+    CAMLlocal2(Option, Str);
+
+    Str = caml_alloc_string(Len);
+    memcpy(String_val(Str), S, Len);
+    Option = alloc(1,0);
+    Store_field(Option, 0, Str);
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
+CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value name)
+{
+  CAMLparam1(name);
+  CAMLlocal1(Nodes);
+  Nodes = alloc(LLVMGetNamedMetadataNumOperands(M, String_val(name)), 0);
+  LLVMGetNamedMetadataOperands(M, String_val(name), (LLVMValueRef *) Nodes);
+  CAMLreturn(Nodes);
+}
 /*--... Operations on scalar constants .....................................--*/
 
 /* lltype -> int -> llvalue */
@@ -629,6 +637,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 */
@@ -680,6 +696,42 @@ CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
   return Val_unit;
 }
 
+/*--... Operations on uses .................................................--*/
+
+/* llvalue -> lluse option */
+CAMLprim value llvm_use_begin(LLVMValueRef Val) {
+  CAMLparam0();
+  LLVMUseRef First;
+  if ((First = LLVMGetFirstUse(Val))) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) First;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
+/* lluse -> lluse option */
+CAMLprim value llvm_use_succ(LLVMUseRef U) {
+  CAMLparam0();
+  LLVMUseRef Next;
+  if ((Next = LLVMGetNextUse(U))) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) Next;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
+/* lluse -> llvalue */
+CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) {
+  return LLVMGetUser(UR);
+}
+
+/* lluse -> llvalue */
+CAMLprim LLVMValueRef llvm_used_value(LLVMUseRef UR) {
+  return LLVMGetUsedValue(UR);
+}
+
 /*--... Operations on global variables .....................................--*/
 
 DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef,
@@ -787,6 +839,13 @@ CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
   return Val_unit;
 }
 
+/*--... Operations on aliases ..............................................--*/
+
+CAMLprim LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty,
+                                     LLVMValueRef Aliasee, value Name) {
+  return LLVMAddAlias(M, Ty, Aliasee, String_val(Name));
+}
+
 /*--... Operations on functions ............................................--*/
 
 DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef,
@@ -871,13 +930,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 ...........................................--*/
@@ -889,8 +948,8 @@ CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
   return LLVMGetParam(Fn, Int_val(Index));
 }
 
-/* llvalue -> int -> llvalue */
-CAMLprim value llvm_params(LLVMValueRef Fn, value Index) {
+/* llvalue -> llvalue */
+CAMLprim value llvm_params(LLVMValueRef Fn) {
   value Params = alloc(LLVMCountParams(Fn), 0);
   LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
   return Params;
@@ -898,13 +957,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;
 }
 
@@ -955,6 +1014,19 @@ DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
                  LLVMGetInstructionParent)
 
 
+/* llvalue -> ICmp.t */
+CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
+  CAMLparam0();
+  int x = LLVMGetICmpPredicate(Val);
+  if (x) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = Val_int(x - LLVMIntEQ);
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
+
 /*--... Operations on call sites ...........................................--*/
 
 /* llvalue -> int */
@@ -972,7 +1044,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;
 }
 
@@ -980,7 +1052,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;
 }
 
@@ -1198,9 +1270,17 @@ CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
                                Args[4], Args[5]);
 }
 
-/* llbuilder -> llvalue */
-CAMLprim LLVMValueRef llvm_build_unwind(value B) {
-  return LLVMBuildUnwind(Builder_val(B));
+CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
+                                            value NumClauses,  value Name,
+                                            value B) {
+    return LLVMBuildLandingPad(Builder_val(B), Ty, PersFn, Int_val(NumClauses),
+                               String_val(Name));
+}
+
+CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
+{
+    LLVMSetCleanup(LandingPadInst, Bool_val(flag));
+    return Val_unit;
 }
 
 /* llbuilder -> llvalue */
@@ -1682,14 +1762,6 @@ CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS,
   return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name));
 }
 
-/*===-- Module Providers --------------------------------------------------===*/
-
-/* llmoduleprovider -> unit */
-CAMLprim value llvm_dispose_module_provider(LLVMModuleProviderRef MP) {
-  LLVMDisposeModuleProvider(MP);
-  return Val_unit;
-}
-
 
 /*===-- Memory buffers ----------------------------------------------------===*/