llvm.org GIT mirror llvm / e623050
Add a LLVMWriteBitcodeToFD that exposes the raw_fd_ostream options. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@97858 91177308-0d34-0410-b5e6-96231b3b80d8 Erick Tryzelaar 10 years ago
6 changed file(s) with 80 addition(s) and 10 deletion(s). Raw diff Collapse all Expand all
2727 int res = LLVMWriteBitcodeToFile((LLVMModuleRef) M, String_val(Path));
2828 return Val_bool(res == 0);
2929 }
30
31 /* ?unbuffered:bool -> Llvm.llmodule -> Unix.file_descr -> bool */
32 CAMLprim value llvm_write_bitcode_to_fd(value U, value M, value FD) {
33 int Unbuffered;
34 int res;
35
36 if (U == Val_int(0)) {
37 Unbuffered = 0;
38 } else {
39 Unbuffered = Bool_val(Field(U,0));
40 }
41
42 res = LLVMWriteBitcodeToFD((LLVMModuleRef) M, Int_val(FD), 0, Unbuffered);
43 return Val_bool(res == 0);
44 }
1515 (* Writes the bitcode for module the given path. Returns true if successful. *)
1616 external write_bitcode_file : Llvm.llmodule -> string -> bool
1717 = "llvm_write_bitcode_file"
18
19 external write_bitcode_to_fd : ?unbuffered:bool -> Llvm.llmodule
20 -> Unix.file_descr -> bool
21 = "llvm_write_bitcode_to_fd"
22
23 let output_bitcode ?unbuffered channel m =
24 write_bitcode_to_fd ?unbuffered m (Unix.descr_of_out_channel channel)
1515 [path]. Returns [true] if successful, [false] otherwise. *)
1616 external write_bitcode_file : Llvm.llmodule -> string -> bool
1717 = "llvm_write_bitcode_file"
18
19 (** [write_bitcode_to_fd ~unbuffered fd m] writes the bitcode for module
20 [m] to the channel [c]. If [unbuffered] is [true], after every write the fd
21 will be flushed. Returns [true] if successful, [false] otherwise. *)
22 external write_bitcode_to_fd : ?unbuffered:bool -> Llvm.llmodule
23 -> Unix.file_descr -> bool
24 = "llvm_write_bitcode_to_fd"
25
26 (** [output_bitcode ~unbuffered c m] writes the bitcode for module [m]
27 to the channel [c]. If [unbuffered] is [true], after every write the fd
28 will be flushed. Returns [true] if successful, [false] otherwise. *)
29 val output_bitcode : ?unbuffered:bool -> out_channel -> Llvm.llmodule -> bool
2727
2828 /*===-- Operations on modules ---------------------------------------------===*/
2929
30 /* Writes a module to an open file descriptor. Returns 0 on success.
31 Closes the Handle. Use dup first if this is not what you want. */
32 int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int Handle);
33
34 /* Writes a module to the specified path. Returns 0 on success. */
30 /** Writes a module to the specified path. Returns 0 on success. */
3531 int LLVMWriteBitcodeToFile(LLVMModuleRef M, const char *Path);
3632
33 /** Writes a module to an open file descriptor. Returns 0 on success. */
34 int LLVMWriteBitcodeToFD(LLVMModuleRef M, int FD, int ShouldClose,
35 int Unbuffered);
36
37 /** Deprecated for LLVMWriteBitcodeToFD. Writes a module to an open file
38 descriptor. Returns 0 on success. Closes the Handle. */
39 int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int Handle);
3740
3841 #ifdef __cplusplus
3942 }
2626 return 0;
2727 }
2828
29 int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int FileHandle) {
30 raw_fd_ostream OS(FileHandle, true);
29 int LLVMWriteBitcodeToFD(LLVMModuleRef M, int FD, int ShouldClose,
30 int Unbuffered) {
31 raw_fd_ostream OS(FD, ShouldClose, Unbuffered);
3132
3233 WriteBitcodeToFile(unwrap(M), OS);
3334 return 0;
3435 }
36
37 int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int FileHandle) {
38 return LLVMWriteBitcodeToFD(M, FileHandle, true, false);
39 }
None (* RUN: %ocamlopt -warn-error A llvm.cmxa llvm_bitwriter.cmxa %s -o %t
0 (* RUN: %ocamlopt -warn-error A unix.cmxa llvm.cmxa llvm_bitwriter.cmxa %s -o %t
11 * RUN: ./%t %t.bc
22 * RUN: llvm-dis < %t.bc | grep caml_int_ty
33 *)
99
1010 let test x = if not x then exit 1 else ()
1111
12 let read_file name =
13 let ic = open_in_bin name in
14 let len = in_channel_length ic in
15 let buf = String.create len in
16
17 test ((input ic buf 0 len) = len);
18
19 close_in ic;
20
21 buf
22
23 let temp_bitcode ?unbuffered m =
24 let temp_name, temp_oc = Filename.open_temp_file ~mode:[Open_binary] "" "" in
25
26 test (Llvm_bitwriter.output_bitcode ?unbuffered temp_oc m);
27 flush temp_oc;
28
29 let temp_buf = read_file temp_name in
30
31 close_out temp_oc;
32
33 temp_buf
34
1235 let _ =
1336 let m = Llvm.create_module context "ocaml_test_module" in
1437
1538 ignore (Llvm.define_type_name "caml_int_ty" (Llvm.i32_type context) m);
16
17 test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1))
39
40 test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1));
41 let file_buf = read_file Sys.argv.(1) in
42
43 test (file_buf = temp_bitcode m);
44 test (file_buf = temp_bitcode ~unbuffered:false m);
45 test (file_buf = temp_bitcode ~unbuffered:true m)