X-Git-Url: http://plrg.eecs.uci.edu/git/?a=blobdiff_plain;f=bindings%2Focaml%2Fllvm%2Fllvm_ocaml.c;h=d8856e74e4d75daadb778f9ef5f128ce9f8fad5c;hb=a09a89983bf51aa70d3067282e4817ec3057eb51;hp=342d890e7473996bab22869c489866ef2ac4f3fc;hpb=80a75bfae980df96f969f1c05b0c4a80ce975240;p=oota-llvm.git

diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 342d890e747..d8856e74e4d 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -18,10 +18,35 @@
 #include "llvm-c/Core.h"
 #include "caml/alloc.h"
 #include "caml/custom.h"
-#include "caml/mlvalues.h"
 #include "caml/memory.h"
+#include "caml/fail.h"
+#include "caml/callback.h"
 #include "llvm/Config/config.h"
 #include <assert.h>
+#include <stdlib.h>
+
+
+/* Can't use the recommended caml_named_value mechanism for backwards
+   compatibility reasons. This is largely equivalent. */
+static value llvm_ioerror_exn;
+
+CAMLprim value llvm_register_core_exns(value IoError) {
+  llvm_ioerror_exn = Field(IoError, 0);
+  register_global_root(&llvm_ioerror_exn);
+  return Val_unit;
+}
+
+static void llvm_raise(value Prototype, char *Message) {
+  CAMLparam1(Prototype);
+  CAMLlocal1(CamlMessage);
+  
+  CamlMessage = copy_string(Message);
+  LLVMDisposeMessage(Message);
+  
+  raise_with_arg(Prototype, CamlMessage);
+  abort(); /* NOTREACHED */
+  CAMLnoreturn;
+}
 
 
 /*===-- Modules -----------------------------------------------------------===*/
@@ -52,7 +77,7 @@ CAMLprim value llvm_delete_type_name(value Name, LLVMModuleRef M) {
 
 /*===-- Types -------------------------------------------------------------===*/
 
-/* lltype -> type_kind */
+/* lltype -> TypeKind.t */
 CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
   return Val_int(LLVMGetTypeKind(Ty));
 }
@@ -163,6 +188,17 @@ CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) {
   return LLVMArrayType(ElementTy, Int_val(Count));
 }
 
+/* lltype -> lltype */
+CAMLprim LLVMTypeRef llvm_pointer_type(LLVMTypeRef ElementTy) {
+  return LLVMPointerType(ElementTy, 0);
+}
+
+/* lltype -> int -> lltype */
+CAMLprim LLVMTypeRef llvm_qualified_pointer_type(LLVMTypeRef ElementTy,
+                                                 value AddressSpace) {
+  return LLVMPointerType(ElementTy, Int_val(AddressSpace));
+}
+
 /* lltype -> int -> lltype */
 CAMLprim LLVMTypeRef llvm_vector_type(LLVMTypeRef ElementTy, value Count) {
   return LLVMVectorType(ElementTy, Int_val(Count));
@@ -173,6 +209,11 @@ CAMLprim value llvm_array_length(LLVMTypeRef ArrayTy) {
   return Val_int(LLVMGetArrayLength(ArrayTy));
 }
 
+/* lltype -> int */
+CAMLprim value llvm_address_space(LLVMTypeRef PtrTy) {
+  return Val_int(LLVMGetPointerAddressSpace(PtrTy));
+}
+
 /* lltype -> int */
 CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) {
   return Val_int(LLVMGetVectorSize(VectorTy));
@@ -193,7 +234,7 @@ CAMLprim LLVMTypeRef llvm_opaque_type(value Unit) {
 
 #define Typehandle_val(v)  (*(LLVMTypeHandleRef *)(Data_custom_val(v)))
 
-void llvm_finalize_handle(value TH) {
+static void llvm_finalize_handle(value TH) {
   LLVMDisposeTypeHandle(Typehandle_val(TH));
 }
 
@@ -320,14 +361,14 @@ CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
 
 /*--... Constant expressions ...............................................--*/
 
-/* int_predicate -> llvalue -> llvalue -> llvalue */
+/* Icmp.t -> llvalue -> llvalue -> llvalue */
 CAMLprim LLVMValueRef llvm_const_icmp(value Pred,
                                       LLVMValueRef LHSConstant,
                                       LLVMValueRef RHSConstant) {
   return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant);
 }
 
-/* real_predicate -> llvalue -> llvalue -> llvalue */
+/* Fcmp.t -> llvalue -> llvalue -> llvalue */
 CAMLprim LLVMValueRef llvm_const_fcmp(value Pred,
                                       LLVMValueRef LHSConstant,
                                       LLVMValueRef RHSConstant) {
@@ -347,12 +388,12 @@ CAMLprim value llvm_is_declaration(LLVMValueRef Global) {
   return Val_bool(LLVMIsDeclaration(Global));
 }
 
-/* llvalue -> linkage */
+/* llvalue -> Linkage.t */
 CAMLprim value llvm_linkage(LLVMValueRef Global) {
   return Val_int(LLVMGetLinkage(Global));
 }
 
-/* linkage -> llvalue -> unit */
+/* Linkage.t -> llvalue -> unit */
 CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) {
   LLVMSetLinkage(Global, Int_val(Linkage));
   return Val_unit;
@@ -369,12 +410,12 @@ CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) {
   return Val_unit;
 }
 
-/* llvalue -> visibility */
+/* llvalue -> Visibility.t */
 CAMLprim value llvm_visibility(LLVMValueRef Global) {
   return Val_int(LLVMGetVisibility(Global));
 }
 
-/* visibility -> llvalue -> unit */
+/* Visibility.t -> llvalue -> unit */
 CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) {
   LLVMSetVisibility(Global, Int_val(Viz));
   return Val_unit;
@@ -399,7 +440,7 @@ CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
   LLVMValueRef GlobalVar;
   if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
     if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
-      return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty));
+      return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty, 0));
     return GlobalVar;
   }
   return LLVMAddGlobal(M, Ty, String_val(Name));
@@ -476,7 +517,7 @@ CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
   LLVMValueRef Fn;
   if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
     if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
-      return LLVMConstBitCast(Fn, LLVMPointerType(Ty));
+      return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0));
     return Fn;
   }
   return LLVMAddFunction(M, String_val(Name), Ty);
@@ -627,7 +668,7 @@ CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
 
 #define Builder_val(v)  (*(LLVMBuilderRef *)(Data_custom_val(v)))
 
-void llvm_finalize_builder(value B) {
+static void llvm_finalize_builder(value B) {
   LLVMDisposeBuilder(Builder_val(B));
 }
 
@@ -640,24 +681,29 @@ static struct custom_operations builder_ops = {
   custom_deserialize_default
 };
 
+static value alloc_builder(LLVMBuilderRef B) {
+  value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
+  Builder_val(V) = B;
+  return V;
+}
+
+/* unit-> llbuilder */
+CAMLprim value llvm_builder(value Unit) {
+  return alloc_builder(LLVMCreateBuilder());
+}
+
 /* llvalue -> llbuilder */
 CAMLprim value llvm_builder_before(LLVMValueRef Inst) {
-  value V;
   LLVMBuilderRef B = LLVMCreateBuilder();
   LLVMPositionBuilderBefore(B, Inst);
-  V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
-  Builder_val(V) = B;
-  return V;
+  return alloc_builder(B);
 }
 
 /* llbasicblock -> llbuilder */
 CAMLprim value llvm_builder_at_end(LLVMBasicBlockRef BB) {
-  value V;
   LLVMBuilderRef B = LLVMCreateBuilder();
   LLVMPositionBuilderAtEnd(B, BB);
-  V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
-  Builder_val(V) = B;
-  return V;
+  return alloc_builder(B);
 }
 
 /* llvalue -> llbuilder -> unit */
@@ -965,7 +1011,7 @@ CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
 
 /*--... Comparisons ........................................................--*/
 
-/* int_predicate -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
+/* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_icmp(value Pred,
                                       LLVMValueRef LHS, LLVMValueRef RHS,
                                       value Name, value B) {
@@ -973,7 +1019,7 @@ CAMLprim LLVMValueRef llvm_build_icmp(value Pred,
                        String_val(Name));
 }
 
-/* real_predicate -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
+/* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
                                       LLVMValueRef LHS, LLVMValueRef RHS,
                                       value Name, value B) {
@@ -1047,3 +1093,47 @@ CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2,
   return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name));
 }
 
+
+/*===-- Module Providers --------------------------------------------------===*/
+
+/* llmoduleprovider -> unit */
+CAMLprim value llvm_dispose_module_provider(LLVMModuleProviderRef MP) {
+  LLVMDisposeModuleProvider(MP);
+  return Val_unit;
+}
+
+
+/*===-- Memory buffers ----------------------------------------------------===*/
+
+/* string -> llmemorybuffer
+   raises IoError msg on error */
+CAMLprim value llvm_memorybuffer_of_file(value Path) {
+  CAMLparam1(Path);
+  char *Message;
+  LLVMMemoryBufferRef MemBuf;
+  
+  if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path),
+                                               &MemBuf, &Message))
+    llvm_raise(llvm_ioerror_exn, Message);
+  
+  CAMLreturn((value) MemBuf);
+}
+
+/* unit -> llmemorybuffer
+   raises IoError msg on error */
+CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
+  char *Message;
+  LLVMMemoryBufferRef MemBuf;
+  
+  if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message))
+    llvm_raise(llvm_ioerror_exn, Message);
+  
+  return MemBuf;
+}
+
+/* llmemorybuffer -> unit */
+CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) {
+  LLVMDisposeMemoryBuffer(MemBuf);
+  return Val_unit;
+}
+