[PATCH] OCaml bindings: implement Llvm.MemoryBuffer.{of_string, as_string}

[Peter Zotov]

Hi sylvestre.ledru,

This commit implements conversion of Llvm.llmemorybuffer to and from an OCaml string, useful for Llvm_target_machine.emit* functions.

The buffer contents is always copied, since OCaml's moving GC does not allow for sharing.

http://llvm-reviews.chandlerc.com/D1931

Files:
  bindings/ocaml/llvm/llvm.ml
  bindings/ocaml/llvm/llvm.mli
  bindings/ocaml/llvm/llvm_ocaml.c
  test/Bindings/Ocaml/vmcore.ml

Index: bindings/ocaml/llvm/llvm.ml
===================================================================
--- bindings/ocaml/llvm/llvm.ml
+++ bindings/ocaml/llvm/llvm.ml
@@ -1231,6 +1231,8 @@
 module MemoryBuffer = struct
   external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file"
   external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin"
+  external of_string : ?name:string -> string -> llmemorybuffer = "llvm_memorybuffer_of_string"
+  external as_string : llmemorybuffer -> string = "llvm_memorybuffer_as_string"
   external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose"
 end
 
Index: bindings/ocaml/llvm/llvm.mli
===================================================================
--- bindings/ocaml/llvm/llvm.mli
+++ bindings/ocaml/llvm/llvm.mli
@@ -2472,6 +2472,13 @@
   (** [of_stdin ()] is the memory buffer containing the contents of standard input.
       If standard input is empty, then [IoError msg] is raised. *)
   val of_stdin : unit -> llmemorybuffer
+
+  (** [of_string ~name s] is the memory buffer containing the contents of string [s].
+      The name of memory buffer is set to [name] if it is provided. *)
+  val of_string : ?name:string -> string -> llmemorybuffer
+
+  (** [as_string mb] is the string containing the contents of memory buffer [mb]. *)
+  val as_string : llmemorybuffer -> string
   
   (** Disposes of a memory buffer. *)
   val dispose : llmemorybuffer -> unit
Index: bindings/ocaml/llvm/llvm_ocaml.c
===================================================================
--- bindings/ocaml/llvm/llvm_ocaml.c
+++ bindings/ocaml/llvm/llvm_ocaml.c
@@ -2105,6 +2105,30 @@
   return MemBuf;
 }
 
+/* ?name:string -> string -> llmemorybuffer */
+CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_string(value Name, value String) {
+  const char *NameCStr;
+  if(Name == Val_int(0))
+    NameCStr = "";
+  else
+    NameCStr = String_val(Field(Name, 0));
+
+  LLVMMemoryBufferRef MemBuf;
+  MemBuf = LLVMCreateMemoryBufferWithMemoryRangeCopy(
+                String_val(String), caml_string_length(String), NameCStr);
+
+  return MemBuf;
+}
+
+/* llmemorybuffer -> string */
+CAMLprim value llvm_memorybuffer_as_string(LLVMMemoryBufferRef MemBuf) {
+  value String = caml_alloc_string(LLVMGetBufferSize(MemBuf));
+  memcpy(String_val(String), LLVMGetBufferStart(MemBuf), 
+         LLVMGetBufferSize(MemBuf));
+
+  return String;
+}
+
 /* llmemorybuffer -> unit */
 CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) {
   LLVMDisposeMemoryBuffer(MemBuf);
Index: test/Bindings/Ocaml/vmcore.ml
===================================================================
--- test/Bindings/Ocaml/vmcore.ml
+++ test/Bindings/Ocaml/vmcore.ml
@@ -1355,6 +1355,14 @@
 
 (*===-- Writer ------------------------------------------------------------===*)
 
+let test_memory_buffer () =
+  group "memory buffer";
+  let buf = MemoryBuffer.of_string "foobar" in
+  insist ((MemoryBuffer.as_string buf) = "foobar")
+
+
+(*===-- Writer ------------------------------------------------------------===*)
+
 let test_writer () =
   group "valid";
   insist (match Llvm_analysis.verify_module m with
@@ -1383,5 +1391,6 @@
   suite "instructions"     test_instructions;
   suite "builder"          test_builder;
   suite "pass manager"     test_pass_manager;
+  suite "memory buffer"    test_memory_buffer;
   suite "writer"           test_writer; (* Keep this last; it disposes m. *)
   exit !exit_status
-------------- next part --------------
A non-text attachment was scrubbed...
Name: D1931.1.patch
Type: text/x-patch
Size: 3482 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20131014/092d1715/attachment.bin>