From ec7270c966b4a49840b1801bfbb11977d76cb333 Mon Sep 17 00:00:00 2001 From: Peter Zotov Date: Wed, 6 Nov 2013 09:21:25 +0000 Subject: [PATCH] [OCaml] Impement Llvm_irreader, bindings to LLVM assembly parser git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@194138 91177308-0d34-0410-b5e6-96231b3b80d8 --- bindings/ocaml/Makefile | 3 +- bindings/ocaml/irreader/Makefile | 19 ++++++++ bindings/ocaml/irreader/irreader_ocaml.c | 59 +++++++++++++++++++++++ bindings/ocaml/irreader/llvm_irreader.ml | 17 +++++++ bindings/ocaml/irreader/llvm_irreader.mli | 21 ++++++++ bindings/ocaml/llvm/META.llvm.in | 8 +++ test/Bindings/Ocaml/irreader.ml | 59 +++++++++++++++++++++++ 7 files changed, 185 insertions(+), 1 deletion(-) create mode 100644 bindings/ocaml/irreader/Makefile create mode 100644 bindings/ocaml/irreader/irreader_ocaml.c create mode 100644 bindings/ocaml/irreader/llvm_irreader.ml create mode 100644 bindings/ocaml/irreader/llvm_irreader.mli create mode 100644 test/Bindings/Ocaml/irreader.ml diff --git a/bindings/ocaml/Makefile b/bindings/ocaml/Makefile index 4d80e2ff95b..19ba3022454 100644 --- a/bindings/ocaml/Makefile +++ b/bindings/ocaml/Makefile @@ -8,7 +8,8 @@ ##===----------------------------------------------------------------------===## LEVEL := ../.. -DIRS = llvm bitreader bitwriter analysis target executionengine transforms linker +DIRS = llvm bitreader bitwriter irreader analysis target executionengine \ + transforms linker ExtraMakefiles = $(PROJ_OBJ_DIR)/Makefile.ocaml ocamldoc: diff --git a/bindings/ocaml/irreader/Makefile b/bindings/ocaml/irreader/Makefile new file mode 100644 index 00000000000..7665999bb76 --- /dev/null +++ b/bindings/ocaml/irreader/Makefile @@ -0,0 +1,19 @@ +##===- bindings/ocaml/irreader/Makefile --------------------*- Makefile -*-===## +# +# The LLVM Compiler Infrastructure +# +# This file is distributed under the University of Illinois Open Source +# License. See LICENSE.TXT for details. +# +##===----------------------------------------------------------------------===## +# +# This is the makefile for the Objective Caml Llvm_irreader interface. +# +##===----------------------------------------------------------------------===## + +LEVEL := ../../.. +LIBRARYNAME := llvm_irreader +UsedComponents := irreader +UsedOcamlInterfaces := llvm + +include ../Makefile.ocaml diff --git a/bindings/ocaml/irreader/irreader_ocaml.c b/bindings/ocaml/irreader/irreader_ocaml.c new file mode 100644 index 00000000000..30c10c7b8b0 --- /dev/null +++ b/bindings/ocaml/irreader/irreader_ocaml.c @@ -0,0 +1,59 @@ +/*===-- irreader_ocaml.c - LLVM OCaml Glue ----------------------*- C++ -*-===*\ +|* *| +|* The LLVM Compiler Infrastructure *| +|* *| +|* This file 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/IRReader.h" +#include "caml/alloc.h" +#include "caml/fail.h" +#include "caml/memory.h" + +/* Can't use the recommended caml_named_value mechanism for backwards + compatibility reasons. This is largely equivalent. */ +static value llvm_irreader_error_exn; + +CAMLprim value llvm_register_irreader_exns(value Error) { + llvm_irreader_error_exn = Field(Error, 0); + register_global_root(&llvm_irreader_error_exn); + return Val_unit; +} + +static void llvm_raise(value Prototype, char *Message) { + CAMLparam1(Prototype); + CAMLlocal1(CamlMessage); + + CamlMessage = copy_string(Message); + LLVMDisposeMessage(Message); + + raise_with_arg(Prototype, CamlMessage); + abort(); /* NOTREACHED */ +#ifdef CAMLnoreturn + CAMLnoreturn; /* Silences warnings, but is missing in some versions. */ +#endif +} + + +/*===-- Modules -----------------------------------------------------------===*/ + +/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */ +CAMLprim value llvm_parse_ir(LLVMContextRef C, + LLVMMemoryBufferRef MemBuf) { + CAMLparam0(); + CAMLlocal2(Variant, MessageVal); + LLVMModuleRef M; + char *Message; + + if (LLVMParseIRInContext(C, MemBuf, &M, &Message)) + llvm_raise(llvm_irreader_error_exn, Message); + + CAMLreturn((value) M); +} diff --git a/bindings/ocaml/irreader/llvm_irreader.ml b/bindings/ocaml/irreader/llvm_irreader.ml new file mode 100644 index 00000000000..455b1fae032 --- /dev/null +++ b/bindings/ocaml/irreader/llvm_irreader.ml @@ -0,0 +1,17 @@ +(*===-- llvm_irreader.ml - LLVM OCaml Interface ---------------*- OCaml -*-===* + * + * The LLVM Compiler Infrastructure + * + * This file is distributed under the University of Illinois Open Source + * License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------===*) + + +exception Error of string + +external register_exns : exn -> unit = "llvm_register_irreader_exns" +let _ = register_exns (Error "") + +external parse_ir : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule + = "llvm_parse_ir" diff --git a/bindings/ocaml/irreader/llvm_irreader.mli b/bindings/ocaml/irreader/llvm_irreader.mli new file mode 100644 index 00000000000..2b1147373b5 --- /dev/null +++ b/bindings/ocaml/irreader/llvm_irreader.mli @@ -0,0 +1,21 @@ +(*===-- llvm_irreader.mli - LLVM OCaml Interface --------------*- OCaml -*-===* + * + * The LLVM Compiler Infrastructure + * + * This file is distributed under the University of Illinois Open Source + * License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------===*) + +(** IR reader. + + This interface provides an OCaml API for the LLVM assembly reader, the + classes in the IRReader library. *) + +exception Error of string + +(** [parse_ir context mb] parses the IR for a new module [m] from the + memory buffer [mb] in the context [context]. Returns [m] if successful, or + raises [Error msg] otherwise, where [msg] is a description of the error + encountered. See the function [llvm::ParseIR]. *) +val parse_ir : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule diff --git a/bindings/ocaml/llvm/META.llvm.in b/bindings/ocaml/llvm/META.llvm.in index 08e8d283318..c241ea514cb 100644 --- a/bindings/ocaml/llvm/META.llvm.in +++ b/bindings/ocaml/llvm/META.llvm.in @@ -46,6 +46,14 @@ package "ipo" ( archive(native) = "llvm_ipo.cmxa" ) +package "irreader" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "IR assembly reader for LLVM" + archive(byte) = "llvm_irreader.cma" + archive(native) = "llvm_irreader.cmxa" +) + package "scalar_opts" ( requires = "llvm" version = "@PACKAGE_VERSION@" diff --git a/test/Bindings/Ocaml/irreader.ml b/test/Bindings/Ocaml/irreader.ml new file mode 100644 index 00000000000..3511c2b2364 --- /dev/null +++ b/test/Bindings/Ocaml/irreader.ml @@ -0,0 +1,59 @@ +(* RUN: rm -rf %t.builddir + * RUN: mkdir -p %t.builddir + * RUN: cp %s %t.builddir + * RUN: %ocamlopt -g -warn-error A llvm.cmxa llvm_irreader.cmxa %t.builddir/irreader.ml -o %t + * RUN: %t + * XFAIL: vg_leak + *) + +(* Note: It takes several seconds for ocamlopt to link an executable with + libLLVMCore.a, so it's better to write a big test than a bunch of + little ones. *) + +open Llvm +open Llvm_irreader + +let context = global_context () + +(* Tiny unit test framework - really just to help find which line is busted *) +let print_checkpoints = false + +let suite name f = + if print_checkpoints then + prerr_endline (name ^ ":"); + f () + +let _ = + Printexc.record_backtrace true + +let insist cond = + if not cond then failwith "insist" + + +(*===-- IR Reader ---------------------------------------------------------===*) + +let test_irreader () = + begin + let buf = MemoryBuffer.of_string "@foo = global i32 42" in + let m = parse_ir context buf in + match lookup_global "foo" m with + | Some foo -> + insist ((global_initializer foo) = (const_int (i32_type context) 42)) + | None -> + failwith "global" + end; + + begin + let buf = MemoryBuffer.of_string "@foo = global garble" in + try + ignore (parse_ir context buf); + failwith "parsed" + with Llvm_irreader.Error _ -> + () + end + + +(*===-- Driver ------------------------------------------------------------===*) + +let _ = + suite "irreader" test_irreader -- 2.34.1