diff options
Diffstat (limited to 'bindings/ocaml/bitreader')
-rw-r--r-- | bindings/ocaml/bitreader/bitreader_ocaml.c | 53 | ||||
-rw-r--r-- | bindings/ocaml/bitreader/llvm_bitreader.ml | 12 | ||||
-rw-r--r-- | bindings/ocaml/bitreader/llvm_bitreader.mli | 21 |
3 files changed, 54 insertions, 32 deletions
diff --git a/bindings/ocaml/bitreader/bitreader_ocaml.c b/bindings/ocaml/bitreader/bitreader_ocaml.c index 7088fa5a47..87477f6312 100644 --- a/bindings/ocaml/bitreader/bitreader_ocaml.c +++ b/bindings/ocaml/bitreader/bitreader_ocaml.c @@ -16,31 +16,46 @@ #include "caml/alloc.h" #include "caml/mlvalues.h" #include "caml/memory.h" +#include <stdio.h> + + +/* Can't use the recommended caml_named_value mechanism for backwards + compatibility reasons. This is largely equivalent. */ +static value llvm_bitreader_error_exn; + +CAMLprim value llvm_register_bitreader_exns(value Error) { + llvm_bitreader_error_exn = Field(Error, 0); + register_global_root(&llvm_bitreader_error_exn); + return Val_unit; +} + +void llvm_raise(value Prototype, char *Message); + /*===-- Modules -----------------------------------------------------------===*/ -/* string -> bitreader_result +/* Llvm.llmemorybuffer -> Llvm.module */ +CAMLprim value llvm_get_module_provider(LLVMMemoryBufferRef MemBuf) { + CAMLparam0(); + CAMLlocal2(Variant, MessageVal); + char *Message; + + LLVMModuleProviderRef MP; + if (LLVMGetBitcodeModuleProvider(MemBuf, &MP, &Message)) + llvm_raise(llvm_bitreader_error_exn, Message); + + CAMLreturn((value) MemBuf); +} - type bitreader_result = - | Bitreader_success of Llvm.llmodule - | Bitreader_failure of string - */ -CAMLprim value llvm_read_bitcode_file(value Path) { +/* Llvm.llmemorybuffer -> Llvm.llmodule */ +CAMLprim value llvm_parse_bitcode(LLVMMemoryBufferRef MemBuf) { + CAMLparam0(); + CAMLlocal2(Variant, MessageVal); LLVMModuleRef M; char *Message; - CAMLparam1(Path); - CAMLlocal2(Variant, MessageVal); - if (LLVMReadBitcodeFromFile(String_val(Path), &M, &Message)) { - MessageVal = copy_string(Message); - LLVMDisposeBitcodeReaderMessage(Message); - - Variant = alloc(1, 1); - Field(Variant, 0) = MessageVal; - } else { - Variant = alloc(1, 0); - Field(Variant, 0) = Val_op(M); - } + if (LLVMParseBitcode(MemBuf, &M, &Message)) + llvm_raise(llvm_bitreader_error_exn, Message); - CAMLreturn(Variant); + CAMLreturn((value) M); } diff --git a/bindings/ocaml/bitreader/llvm_bitreader.ml b/bindings/ocaml/bitreader/llvm_bitreader.ml index 39d0434df7..266ff153f3 100644 --- a/bindings/ocaml/bitreader/llvm_bitreader.ml +++ b/bindings/ocaml/bitreader/llvm_bitreader.ml @@ -8,10 +8,12 @@ *===----------------------------------------------------------------------===*) -type bitreader_result = -| Bitreader_success of Llvm.llmodule -| Bitreader_failure of string +exception Error of string +external register_exns : exn -> unit = "llvm_register_bitreader_exns" +let _ = register_exns (Error "") -external read_bitcode_file : string -> bitreader_result - = "llvm_read_bitcode_file" +external get_module_provider : Llvm.llmemorybuffer -> Llvm.llmoduleprovider + = "llvm_get_module_provider" +external parse_bitcode : Llvm.llmemorybuffer -> Llvm.llmodule + = "llvm_parse_bitcode" diff --git a/bindings/ocaml/bitreader/llvm_bitreader.mli b/bindings/ocaml/bitreader/llvm_bitreader.mli index 37750bcdb3..bc5efc880f 100644 --- a/bindings/ocaml/bitreader/llvm_bitreader.mli +++ b/bindings/ocaml/bitreader/llvm_bitreader.mli @@ -13,13 +13,18 @@ *===----------------------------------------------------------------------===*) -type bitreader_result = -| Bitreader_success of Llvm.llmodule -| Bitreader_failure of string +exception Error of string +(** [read_bitcode_file path] reads the bitcode for a new module [m] from the + file at [path]. Returns [Success m] if successful, and [Failure msg] + otherwise, where [msg] is a description of the error encountered. + See the function [llvm::getBitcodeModuleProvider]. **) +external get_module_provider : Llvm.llmemorybuffer -> Llvm.llmoduleprovider + = "llvm_get_module_provider" -(** [read_bitcode_file path] reads the bitcode for module [m] from the file at - [path]. Returns [Reader_success m] if successful, and [Reader_failure msg] - otherwise, where [msg] is a description of the error encountered. **) -external read_bitcode_file : string -> bitreader_result - = "llvm_read_bitcode_file" +(** [parse_bitcode mb] parses the bitcode for a new module [m] from the memory + buffer [mb]. Returns [Success m] if successful, and [Failure msg] otherwise, + where [msg] is a description of the error encountered. + See the function [llvm::ParseBitcodeFile]. **) +external parse_bitcode : Llvm.llmemorybuffer -> Llvm.llmodule + = "llvm_parse_bitcode" |