Adding bindings for memory buffers and module providers. Switching

[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 342d890e7473996bab22869c489866ef2ac4f3fc..5cd9526f560468f7973147b2dc65af76bc0e7ee5 100644 (file)
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -20,8 +20,33 @@
 #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;
+}
+
+void llvm_raise(value Prototype, char *Message) {
+  CAMLparam1(Prototype);
+  CAMLlocal1(CamlMessage);
+  
+  CamlMessage = copy_string(Message);
+  LLVMDisposeMessage(Message);
+  
+  raise_with_arg(Prototype, CamlMessage);
+  CAMLnoreturn;
+}
 
 
 /*===-- Modules -----------------------------------------------------------===*/
@@ -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));
@@ -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);
@@ -1047,3 +1088,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;
+}
+