diff --git a/llvm/bindings/ocaml/Makefile b/llvm/bindings/ocaml/Makefile index a3bbae009406..11abec4f09c1 100644 --- a/llvm/bindings/ocaml/Makefile +++ b/llvm/bindings/ocaml/Makefile @@ -8,6 +8,6 @@ ##===----------------------------------------------------------------------===## LEVEL := ../.. -DIRS = llvm bitwriter analysis +DIRS = llvm bitreader bitwriter analysis include $(LEVEL)/Makefile.common diff --git a/llvm/bindings/ocaml/bitreader/Makefile b/llvm/bindings/ocaml/bitreader/Makefile new file mode 100644 index 000000000000..4acc7ee0304d --- /dev/null +++ b/llvm/bindings/ocaml/bitreader/Makefile @@ -0,0 +1,20 @@ +##===- bindings/ocaml/bitreader/Makefile -------------------*- Makefile -*-===## +# +# The LLVM Compiler Infrastructure +# +# This file was developed by Gordon Henriksen and is distributed under the +# University of Illinois Open Source License. See LICENSE.TXT for details. +# +##===----------------------------------------------------------------------===## +# +# This is the makefile for the Objective Caml Llvm_bitreader interface. +# +##===----------------------------------------------------------------------===## + +LEVEL := ../../.. +LIBRARYNAME := llvm_bitreader +DONT_BUILD_RELINKED := 1 +UsedComponents := bitreader +UsedOcamlInterfaces := llvm + +include ../Makefile.ocaml diff --git a/llvm/bindings/ocaml/bitreader/bitreader_ocaml.c b/llvm/bindings/ocaml/bitreader/bitreader_ocaml.c new file mode 100644 index 000000000000..7088fa5a478c --- /dev/null +++ b/llvm/bindings/ocaml/bitreader/bitreader_ocaml.c @@ -0,0 +1,46 @@ +/*===-- bitwriter_ocaml.c - LLVM Ocaml Glue ---------------------*- C++ -*-===*\ +|* *| +|* The LLVM Compiler Infrastructure *| +|* *| +|* This file was developed by Gordon Henriksen and is distributed under the *| +|* University of Illinois Open Source License. See LICENSE.TXT for details. *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's ocaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/BitReader.h" +#include "caml/alloc.h" +#include "caml/mlvalues.h" +#include "caml/memory.h" + +/*===-- Modules -----------------------------------------------------------===*/ + +/* string -> bitreader_result + + type bitreader_result = + | Bitreader_success of Llvm.llmodule + | Bitreader_failure of string + */ +CAMLprim value llvm_read_bitcode_file(value Path) { + 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); + } + + CAMLreturn(Variant); +} diff --git a/llvm/bindings/ocaml/bitreader/llvm_bitreader.ml b/llvm/bindings/ocaml/bitreader/llvm_bitreader.ml new file mode 100644 index 000000000000..39d0434df7bd --- /dev/null +++ b/llvm/bindings/ocaml/bitreader/llvm_bitreader.ml @@ -0,0 +1,17 @@ +(*===-- llvm_bitreader.ml - LLVM Ocaml Interface ----------------*- C++ -*-===* + * + * The LLVM Compiler Infrastructure + * + * This file was developed by Gordon Henriksen and is distributed under the + * University of Illinois Open Source License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------===*) + + +type bitreader_result = +| Bitreader_success of Llvm.llmodule +| Bitreader_failure of string + + +external read_bitcode_file : string -> bitreader_result + = "llvm_read_bitcode_file" diff --git a/llvm/bindings/ocaml/bitreader/llvm_bitreader.mli b/llvm/bindings/ocaml/bitreader/llvm_bitreader.mli new file mode 100644 index 000000000000..37750bcdb32d --- /dev/null +++ b/llvm/bindings/ocaml/bitreader/llvm_bitreader.mli @@ -0,0 +1,25 @@ +(*===-- llvm_bitreader.mli - LLVM Ocaml Interface ---------------*- C++ -*-===* + * + * The LLVM Compiler Infrastructure + * + * This file was developed by Gordon Henriksen and is distributed under the + * University of Illinois Open Source License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------=== + * + * This interface provides an ocaml API for the LLVM bitcode reader, the + * classes in the Bitreader library. + * + *===----------------------------------------------------------------------===*) + + +type bitreader_result = +| Bitreader_success of Llvm.llmodule +| Bitreader_failure of string + + +(** [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" diff --git a/llvm/include/llvm-c/BitReader.h b/llvm/include/llvm-c/BitReader.h new file mode 100644 index 000000000000..edd5ffa3f12f --- /dev/null +++ b/llvm/include/llvm-c/BitReader.h @@ -0,0 +1,43 @@ +/*===-- llvm-c/BitReader.h - BitReader Library C Interface ------*- C++ -*-===*\ +|* *| +|* The LLVM Compiler Infrastructure *| +|* *| +|* This file was developed by Gordon Henriksen and is distributed under the *| +|* University of Illinois Open Source License. See LICENSE.TXT for details. *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This header declares the C interface to libLLVMBitReader.a, which *| +|* implements input of the LLVM bitcode format. *| +|* *| +|* Many exotic languages can interoperate with C code but have a harder time *| +|* with C++ due to name mangling. So in addition to C, this interface enables *| +|* tools written in such languages. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#ifndef LLVM_C_BITCODEREADER_H +#define LLVM_C_BITCODEREADER_H + +#include "llvm-c/Core.h" + +#ifdef __cplusplus +extern "C" { +#endif + + +/* Reads a module from the specified path, returning a reference to the module + via the OutModule parameter. Returns 0 on success. Optionally returns a + human-readable error message. */ +int LLVMReadBitcodeFromFile(const char *Path, LLVMModuleRef *OutModule, + char **OutMessage); + +/* Disposes of the message allocated by the bitcode reader, if any. */ +void LLVMDisposeBitcodeReaderMessage(char *Message); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/llvm/lib/Bitcode/Reader/BitReader.cpp b/llvm/lib/Bitcode/Reader/BitReader.cpp new file mode 100644 index 000000000000..c6600887bc4e --- /dev/null +++ b/llvm/lib/Bitcode/Reader/BitReader.cpp @@ -0,0 +1,42 @@ +//===-- BitReader.cpp -----------------------------------------------------===// +// +// The LLVM Compiler Infrastructure +// +// This file was developed by Gordon Henriksen and is distributed under the +// University of Illinois Open Source License. See LICENSE.TXT for details. +// +//===----------------------------------------------------------------------===// + +#include "llvm-c/BitReader.h" +#include "llvm/Bitcode/ReaderWriter.h" +#include "llvm/Support/MemoryBuffer.h" +#include + +using namespace llvm; + + +int LLVMReadBitcodeFromFile(const char *Path, LLVMModuleRef *OutModule, + char **OutMessage) { + std::string Message; + + MemoryBuffer *buf = MemoryBuffer::getFile(Path, strlen(Path), &Message); + if (!buf) { + if (!OutMessage) + *OutMessage = strdup(Message.c_str()); + return 1; + } + + *OutModule = wrap(ParseBitcodeFile(buf, &Message)); + if (!*OutModule) { + if (OutMessage) + *OutMessage = strdup(Message.c_str()); + return 1; + } + + return 0; +} + +void LLVMDisposeBitcodeReaderMessage(char *Message) { + if (Message) + free(Message); +} diff --git a/llvm/test/Bindings/Ocaml/bitreader.ml b/llvm/test/Bindings/Ocaml/bitreader.ml new file mode 100644 index 000000000000..0bf8c00bc1f0 --- /dev/null +++ b/llvm/test/Bindings/Ocaml/bitreader.ml @@ -0,0 +1,23 @@ +(* RUN: %ocamlc llvm.cma llvm_bitreader.cma llvm_bitwriter.cma %s -o %t + * RUN: ./%t %t.bc + * RUN: llvm-dis < %t.bc | grep caml_int_ty + *) + +(* Note that this takes a moment to link, so it's best to keep the number of + individual tests low. *) + +let test x = if not x then exit 1 else () + +let _ = + let fn = Sys.argv.(1) in + let m = Llvm.create_module "ocaml_test_module" in + + ignore (Llvm.define_type_name "caml_int_ty" Llvm.i32_type m); + + test (Llvm_bitwriter.write_bitcode_file m fn); + + Llvm.dispose_module m; + + test (match Llvm_bitreader.read_bitcode_file fn with + | Llvm_bitreader.Bitreader_success m -> Llvm.dispose_module m; true + | Llvm_bitreader.Bitreader_failure _ -> false)