path: root/bindings/ocaml/llvm/llvm_ocaml.c

/*===-- llvm_ocaml.h - 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/Core.h"
#include "caml/alloc.h"
#include "caml/custom.h"
#include "caml/memory.h"
#include "caml/fail.h"
#include "caml/callback.h"
#include "llvm/Config/config.h"
#include <assert.h>
#include <stdlib.h>


/* Can't use the recommended caml_named_value mechanism for backwards
   compatibility reasons. This is largely equivalent. */
static value llvm_ioerror_exn;

CAMLprim value llvm_register_core_exns(value IoError) {
  llvm_ioerror_exn = Field(IoError, 0);
  register_global_root(&llvm_ioerror_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 */
}


/*===-- Modules -----------------------------------------------------------===*/

/* string -> llmodule */
CAMLprim LLVMModuleRef llvm_create_module(value ModuleID) {
  return LLVMModuleCreateWithName(String_val(ModuleID));
}

/* llmodule -> unit */
CAMLprim value llvm_dispose_module(LLVMModuleRef M) {
  LLVMDisposeModule(M);
  return Val_unit;
}

/* llmodule -> string */
CAMLprim value llvm_target_triple(LLVMModuleRef M) {
  return copy_string(LLVMGetTarget(M));
}

/* string -> llmodule -> unit */
CAMLprim value llvm_set_target_triple(value Trip, LLVMModuleRef M) {
  LLVMSetTarget(M, String_val(Trip));
  return Val_unit;
}

/* llmodule -> string */
CAMLprim value llvm_data_layout(LLVMModuleRef M) {
  return copy_string(LLVMGetDataLayout(M));
}

/* string -> llmodule -> unit */
CAMLprim value llvm_set_data_layout(value Layout, LLVMModuleRef M) {
  LLVMSetDataLayout(M, String_val(Layout));
  return Val_unit;
}

/* string -> lltype -> llmodule -> bool */
CAMLprim value llvm_add_type_name(value Name, LLVMTypeRef Ty, LLVMModuleRef M) {
  int res = LLVMAddTypeName(M, String_val(Name), Ty);
  return Val_bool(res == 0);
}

/* string -> llmodule -> unit */
CAMLprim value llvm_delete_type_name(value Name, LLVMModuleRef M) {
  LLVMDeleteTypeName(M, String_val(Name));
  return Val_unit;
}


/*===-- Types -------------------------------------------------------------===*/

/* lltype -> TypeKind.t */
CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
  return Val_int(LLVMGetTypeKind(Ty));
}

/*--... Operations on integer types ........................................--*/

/* unit -> lltype */
CAMLprim LLVMTypeRef llvm_i1_type (value Unit) { return LLVMInt1Type();  }
CAMLprim LLVMTypeRef llvm_i8_type (value Unit) { return LLVMInt8Type();  }
CAMLprim LLVMTypeRef llvm_i16_type(value Unit) { return LLVMInt16Type(); }
CAMLprim LLVMTypeRef