From: Peter Zotov Date: Sun, 3 Nov 2013 08:27:32 +0000 (+0000) Subject: [OCaml] Implement Llvm_linker, bindings for the IR linker X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=commitdiff_plain;h=9d33bf70c228a5c3b57b1d9bf86ea5949bb77293 [OCaml] Implement Llvm_linker, bindings for the IR linker git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@193951 91177308-0d34-0410-b5e6-96231b3b80d8 --- diff --git a/bindings/ocaml/Makefile b/bindings/ocaml/Makefile index a89caefb4de..4d80e2ff95b 100644 --- a/bindings/ocaml/Makefile +++ b/bindings/ocaml/Makefile @@ -8,7 +8,7 @@ ##===----------------------------------------------------------------------===## LEVEL := ../.. -DIRS = llvm bitreader bitwriter analysis target executionengine transforms +DIRS = llvm bitreader bitwriter analysis target executionengine transforms linker ExtraMakefiles = $(PROJ_OBJ_DIR)/Makefile.ocaml ocamldoc: diff --git a/bindings/ocaml/linker/Makefile b/bindings/ocaml/linker/Makefile new file mode 100644 index 00000000000..ca1c96c9634 --- /dev/null +++ b/bindings/ocaml/linker/Makefile @@ -0,0 +1,19 @@ +##===- bindings/ocaml/linker/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_target interface. +# +##===----------------------------------------------------------------------===## + +LEVEL := ../../.. +LIBRARYNAME := llvm_linker +UsedComponents := linker +UsedOcamlInterfaces := llvm + +include ../Makefile.ocaml diff --git a/bindings/ocaml/linker/linker_ocaml.c b/bindings/ocaml/linker/linker_ocaml.c new file mode 100644 index 00000000000..2491e3b8fa4 --- /dev/null +++ b/bindings/ocaml/linker/linker_ocaml.c @@ -0,0 +1,54 @@ +/*===-- linker_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. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Linker.h" +#include "caml/alloc.h" +#include "caml/memory.h" +#include "caml/fail.h" + +static value llvm_linker_error_exn; + +CAMLprim value llvm_register_linker_exns(value Error) { + llvm_linker_error_exn = Field(Error, 0); + register_global_root(&llvm_linker_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 +} + +/* llmodule -> llmodule -> Mode.t -> unit + raises Error msg on error */ +CAMLprim value llvm_link_modules(LLVMModuleRef Dst, LLVMModuleRef Src, value Mode) { + char* Message; + + if (LLVMLinkModules(Dst, Src, Int_val(Mode), &Message)) + llvm_raise(llvm_linker_error_exn, Message); + + return Val_unit; +} diff --git a/bindings/ocaml/linker/llvm_linker.ml b/bindings/ocaml/linker/llvm_linker.ml new file mode 100644 index 00000000000..2b73e2e9c4e --- /dev/null +++ b/bindings/ocaml/linker/llvm_linker.ml @@ -0,0 +1,22 @@ +(*===-- llvm_linker.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_linker_exns" +let _ = register_exns (Error "") + +module Mode = struct + type t = + | DestroySource + | PreserveSource +end + +external link_modules : Llvm.llmodule -> Llvm.llmodule -> Mode.t -> unit + = "llvm_link_modules" \ No newline at end of file diff --git a/bindings/ocaml/linker/llvm_linker.mli b/bindings/ocaml/linker/llvm_linker.mli new file mode 100644 index 00000000000..9752b65e4b2 --- /dev/null +++ b/bindings/ocaml/linker/llvm_linker.mli @@ -0,0 +1,27 @@ +(*===-- llvm_linker.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. + * + *===----------------------------------------------------------------------===*) + +(** Linker. + + This interface provides an OCaml API for LLVM bitcode linker, + the classes in the Linker library. *) + +exception Error of string + +(** Linking mode. *) +module Mode : sig + type t = + | DestroySource + | PreserveSource +end + +(** [link_modules dst src mode] links [src] into [dst], raising [Error] + if the linking fails. *) +external link_modules : Llvm.llmodule -> Llvm.llmodule -> Mode.t -> unit + = "llvm_link_modules" \ No newline at end of file diff --git a/bindings/ocaml/llvm/META.llvm.in b/bindings/ocaml/llvm/META.llvm.in index 019e0476ac8..33abf6183fb 100644 --- a/bindings/ocaml/llvm/META.llvm.in +++ b/bindings/ocaml/llvm/META.llvm.in @@ -69,3 +69,11 @@ package "target" ( archive(byte) = "llvm_target.cma" archive(native) = "llvm_target.cmxa" ) + +package "linker" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "Intermediate Representation Linker for LLVM" + archive(byte) = "llvm_linker.cma" + archive(native) = "llvm_linker.cmxa" +) diff --git a/test/Bindings/Ocaml/linker.ml b/test/Bindings/Ocaml/linker.ml new file mode 100644 index 00000000000..9359ae9f2c4 --- /dev/null +++ b/test/Bindings/Ocaml/linker.ml @@ -0,0 +1,63 @@ +(* RUN: rm -rf %t.builddir + * RUN: mkdir -p %t.builddir + * RUN: cp %s %t.builddir + * RUN: %ocamlopt -warn-error A llvm.cmxa llvm_linker.cmxa %t.builddir/linker.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_linker + +let context = global_context () +let void_type = Llvm.void_type 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 () + + +(*===-- Linker -----------------------------------------------------------===*) + +let test_linker () = + let fty = function_type void_type [| |] in + + let make_module name = + let m = create_module context name in + let fn = define_function ("fn_" ^ name) fty m in + ignore (build_ret_void (builder_at_end context (entry_block fn))); + m + in + + let m1 = make_module "one" + and m2 = make_module "two" in + link_modules m1 m2 Mode.PreserveSource; + dispose_module m1; + dispose_module m2; + + let m1 = make_module "one" + and m2 = make_module "two" in + link_modules m1 m2 Mode.DestroySource; + dispose_module m1; + + let m1 = make_module "one" + and m2 = make_module "one" in + try + link_modules m1 m2 Mode.PreserveSource; + failwith "must raise" + with Error _ -> + dispose_module m1; + dispose_module m2 + +(*===-- Driver ------------------------------------------------------------===*) + +let _ = + suite "linker" test_linker