1ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov/*===-- irreader_ocaml.c - LLVM OCaml Glue ----------------------*- C++ -*-===*\
2ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|*                                                                            *|
3ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|*                     The LLVM Compiler Infrastructure                       *|
4ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|*                                                                            *|
5ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|* This file is distributed under the University of Illinois Open Source      *|
6ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|* License. See LICENSE.TXT for details.                                      *|
7ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|*                                                                            *|
8ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|*===----------------------------------------------------------------------===*|
9ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|*                                                                            *|
10ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|* This file glues LLVM's OCaml interface to its C interface. These functions *|
11ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|* are by and large transparent wrappers to the corresponding C functions.    *|
12ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov|*                                                                            *|
13ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov\*===----------------------------------------------------------------------===*/
14ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
15ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov#include "llvm-c/IRReader.h"
16ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov#include "caml/alloc.h"
17ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov#include "caml/fail.h"
18ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov#include "caml/memory.h"
19ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
20ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov/* Can't use the recommended caml_named_value mechanism for backwards
21ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov   compatibility reasons. This is largely equivalent. */
22ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotovstatic value llvm_irreader_error_exn;
23ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
24ec7270c966b4a49840b1801bfbb11977d76cb333Peter ZotovCAMLprim value llvm_register_irreader_exns(value Error) {
25ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  llvm_irreader_error_exn = Field(Error, 0);
26ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  register_global_root(&llvm_irreader_error_exn);
27ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  return Val_unit;
28ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov}
29ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
30ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotovstatic void llvm_raise(value Prototype, char *Message) {
31ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  CAMLparam1(Prototype);
32ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  CAMLlocal1(CamlMessage);
33ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
34ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  CamlMessage = copy_string(Message);
35ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  LLVMDisposeMessage(Message);
36ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
37ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  raise_with_arg(Prototype, CamlMessage);
38ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  abort(); /* NOTREACHED */
39ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov#ifdef CAMLnoreturn
40ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
41ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov#endif
42ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov}
43ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
44ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
45ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov/*===-- Modules -----------------------------------------------------------===*/
46ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
47ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */
48ec7270c966b4a49840b1801bfbb11977d76cb333Peter ZotovCAMLprim value llvm_parse_ir(LLVMContextRef C,
49ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov                             LLVMMemoryBufferRef MemBuf) {
50ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  CAMLparam0();
51ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  CAMLlocal2(Variant, MessageVal);
52ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  LLVMModuleRef M;
53ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  char *Message;
54ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
55ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  if (LLVMParseIRInContext(C, MemBuf, &M, &Message))
56ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov    llvm_raise(llvm_irreader_error_exn, Message);
57ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov
58ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov  CAMLreturn((value) M);
59ec7270c966b4a49840b1801bfbb11977d76cb333Peter Zotov}
60