[llvm-commits] [llvm] r97858 - in /llvm/trunk: bindings/ocaml/bitwriter/bitwriter_ocaml.c bindings/ocaml/bitwriter/llvm_bitwriter.ml bindings/ocaml/bitwriter/llvm_bitwriter.mli include/llvm-c/BitWriter.h lib/Bitcode/Writer/BitWriter.cpp test/Bindings/Ocaml/bitwriter.ml
Erick Tryzelaar
idadesub at users.sourceforge.net
Fri Mar 5 16:30:06 PST 2010
Author: erickt
Date: Fri Mar 5 18:30:06 2010
New Revision: 97858
URL: http://llvm.org/viewvc/llvm-project?rev=97858&view=rev
Log:
Add a LLVMWriteBitcodeToFD that exposes the raw_fd_ostream options.
Modified:
llvm/trunk/bindings/ocaml/bitwriter/bitwriter_ocaml.c
llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.ml
llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.mli
llvm/trunk/include/llvm-c/BitWriter.h
llvm/trunk/lib/Bitcode/Writer/BitWriter.cpp
llvm/trunk/test/Bindings/Ocaml/bitwriter.ml
Modified: llvm/trunk/bindings/ocaml/bitwriter/bitwriter_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/bitwriter/bitwriter_ocaml.c?rev=97858&r1=97857&r2=97858&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/bitwriter/bitwriter_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/bitwriter/bitwriter_ocaml.c Fri Mar 5 18:30:06 2010
@@ -28,3 +28,18 @@
int res = LLVMWriteBitcodeToFile((LLVMModuleRef) M, String_val(Path));
return Val_bool(res == 0);
}
+
+/* ?unbuffered:bool -> Llvm.llmodule -> Unix.file_descr -> bool */
+CAMLprim value llvm_write_bitcode_to_fd(value U, value M, value FD) {
+ int Unbuffered;
+ int res;
+
+ if (U == Val_int(0)) {
+ Unbuffered = 0;
+ } else {
+ Unbuffered = Bool_val(Field(U,0));
+ }
+
+ res = LLVMWriteBitcodeToFD((LLVMModuleRef) M, Int_val(FD), 0, Unbuffered);
+ return Val_bool(res == 0);
+}
Modified: llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.ml?rev=97858&r1=97857&r2=97858&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.ml (original)
+++ llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.ml Fri Mar 5 18:30:06 2010
@@ -16,3 +16,10 @@
(* Writes the bitcode for module the given path. Returns true if successful. *)
external write_bitcode_file : Llvm.llmodule -> string -> bool
= "llvm_write_bitcode_file"
+
+external write_bitcode_to_fd : ?unbuffered:bool -> Llvm.llmodule
+ -> Unix.file_descr -> bool
+ = "llvm_write_bitcode_to_fd"
+
+let output_bitcode ?unbuffered channel m =
+ write_bitcode_to_fd ?unbuffered m (Unix.descr_of_out_channel channel)
Modified: llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.mli?rev=97858&r1=97857&r2=97858&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.mli (original)
+++ llvm/trunk/bindings/ocaml/bitwriter/llvm_bitwriter.mli Fri Mar 5 18:30:06 2010
@@ -16,3 +16,15 @@
[path]. Returns [true] if successful, [false] otherwise. *)
external write_bitcode_file : Llvm.llmodule -> string -> bool
= "llvm_write_bitcode_file"
+
+(** [write_bitcode_to_fd ~unbuffered fd m] writes the bitcode for module
+ [m] to the channel [c]. If [unbuffered] is [true], after every write the fd
+ will be flushed. Returns [true] if successful, [false] otherwise. *)
+external write_bitcode_to_fd : ?unbuffered:bool -> Llvm.llmodule
+ -> Unix.file_descr -> bool
+ = "llvm_write_bitcode_to_fd"
+
+(** [output_bitcode ~unbuffered c m] writes the bitcode for module [m]
+ to the channel [c]. If [unbuffered] is [true], after every write the fd
+ will be flushed. Returns [true] if successful, [false] otherwise. *)
+val output_bitcode : ?unbuffered:bool -> out_channel -> Llvm.llmodule -> bool
Modified: llvm/trunk/include/llvm-c/BitWriter.h
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/include/llvm-c/BitWriter.h?rev=97858&r1=97857&r2=97858&view=diff
==============================================================================
--- llvm/trunk/include/llvm-c/BitWriter.h (original)
+++ llvm/trunk/include/llvm-c/BitWriter.h Fri Mar 5 18:30:06 2010
@@ -28,13 +28,16 @@
/*===-- Operations on modules ---------------------------------------------===*/
-/* Writes a module to an open file descriptor. Returns 0 on success.
- Closes the Handle. Use dup first if this is not what you want. */
-int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int Handle);
-
-/* Writes a module to the specified path. Returns 0 on success. */
+/** Writes a module to the specified path. Returns 0 on success. */
int LLVMWriteBitcodeToFile(LLVMModuleRef M, const char *Path);
+/** Writes a module to an open file descriptor. Returns 0 on success. */
+int LLVMWriteBitcodeToFD(LLVMModuleRef M, int FD, int ShouldClose,
+ int Unbuffered);
+
+/** Deprecated for LLVMWriteBitcodeToFD. Writes a module to an open file
+ descriptor. Returns 0 on success. Closes the Handle. */
+int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int Handle);
#ifdef __cplusplus
}
Modified: llvm/trunk/lib/Bitcode/Writer/BitWriter.cpp
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/lib/Bitcode/Writer/BitWriter.cpp?rev=97858&r1=97857&r2=97858&view=diff
==============================================================================
--- llvm/trunk/lib/Bitcode/Writer/BitWriter.cpp (original)
+++ llvm/trunk/lib/Bitcode/Writer/BitWriter.cpp Fri Mar 5 18:30:06 2010
@@ -27,9 +27,14 @@
return 0;
}
-int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int FileHandle) {
- raw_fd_ostream OS(FileHandle, true);
+int LLVMWriteBitcodeToFD(LLVMModuleRef M, int FD, int ShouldClose,
+ int Unbuffered) {
+ raw_fd_ostream OS(FD, ShouldClose, Unbuffered);
WriteBitcodeToFile(unwrap(M), OS);
return 0;
}
+
+int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int FileHandle) {
+ return LLVMWriteBitcodeToFD(M, FileHandle, true, false);
+}
Modified: llvm/trunk/test/Bindings/Ocaml/bitwriter.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/bitwriter.ml?rev=97858&r1=97857&r2=97858&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/bitwriter.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/bitwriter.ml Fri Mar 5 18:30:06 2010
@@ -1,4 +1,4 @@
-(* RUN: %ocamlopt -warn-error A llvm.cmxa llvm_bitwriter.cmxa %s -o %t
+(* RUN: %ocamlopt -warn-error A unix.cmxa llvm.cmxa llvm_bitwriter.cmxa %s -o %t
* RUN: ./%t %t.bc
* RUN: llvm-dis < %t.bc | grep caml_int_ty
*)
@@ -10,9 +10,37 @@
let test x = if not x then exit 1 else ()
+let read_file name =
+ let ic = open_in_bin name in
+ let len = in_channel_length ic in
+ let buf = String.create len in
+
+ test ((input ic buf 0 len) = len);
+
+ close_in ic;
+
+ buf
+
+let temp_bitcode ?unbuffered m =
+ let temp_name, temp_oc = Filename.open_temp_file ~mode:[Open_binary] "" "" in
+
+ test (Llvm_bitwriter.output_bitcode ?unbuffered temp_oc m);
+ flush temp_oc;
+
+ let temp_buf = read_file temp_name in
+
+ close_out temp_oc;
+
+ temp_buf
+
let _ =
let m = Llvm.create_module context "ocaml_test_module" in
ignore (Llvm.define_type_name "caml_int_ty" (Llvm.i32_type context) m);
-
- test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1))
+
+ test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1));
+ let file_buf = read_file Sys.argv.(1) in
+
+ test (file_buf = temp_bitcode m);
+ test (file_buf = temp_bitcode ~unbuffered:false m);
+ test (file_buf = temp_bitcode ~unbuffered:true m)
More information about the llvm-commits
mailing list