1/*===-- executionengine_ocaml.c - LLVM OCaml Glue ---------------*- C++ -*-===*\
2|*                                                                            *|
3|*                     The LLVM Compiler Infrastructure                       *|
4|*                                                                            *|
5|* This file is distributed under the University of Illinois Open Source      *|
6|* License. See LICENSE.TXT for details.                                      *|
7|*                                                                            *|
8|*===----------------------------------------------------------------------===*|
9|*                                                                            *|
10|* This file glues LLVM's OCaml interface to its C interface. These functions *|
11|* are by and large transparent wrappers to the corresponding C functions.    *|
12|*                                                                            *|
13|* Note that these functions intentionally take liberties with the CAMLparamX *|
14|* macros, since most of the parameters are not GC heap objects.              *|
15|*                                                                            *|
16\*===----------------------------------------------------------------------===*/
17
18#include <string.h>
19#include <assert.h>
20#include "llvm-c/ExecutionEngine.h"
21#include "llvm-c/Target.h"
22#include "caml/alloc.h"
23#include "caml/custom.h"
24#include "caml/fail.h"
25#include "caml/memory.h"
26#include "caml/callback.h"
27
28void llvm_raise(value Prototype, char *Message);
29
30/* unit -> bool */
31CAMLprim value llvm_ee_initialize(value Unit) {
32  LLVMLinkInMCJIT();
33
34  return Val_bool(!LLVMInitializeNativeTarget() &&
35                  !LLVMInitializeNativeAsmParser() &&
36                  !LLVMInitializeNativeAsmPrinter());
37}
38
39/* llmodule -> llcompileroption -> ExecutionEngine.t */
40CAMLprim LLVMExecutionEngineRef llvm_ee_create(value OptRecordOpt, LLVMModuleRef M) {
41  value OptRecord;
42  LLVMExecutionEngineRef MCJIT;
43  char *Error;
44  struct LLVMMCJITCompilerOptions Options;
45
46  LLVMInitializeMCJITCompilerOptions(&Options, sizeof(Options));
47  if (OptRecordOpt != Val_int(0)) {
48    OptRecord = Field(OptRecordOpt, 0);
49    Options.OptLevel = Int_val(Field(OptRecord, 0));
50    Options.CodeModel = Int_val(Field(OptRecord, 1));
51    Options.NoFramePointerElim = Int_val(Field(OptRecord, 2));
52    Options.EnableFastISel = Int_val(Field(OptRecord, 3));
53    Options.MCJMM = NULL;
54  }
55
56  if (LLVMCreateMCJITCompilerForModule(&MCJIT, M, &Options,
57                                      sizeof(Options), &Error))
58    llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
59  return MCJIT;
60}
61
62/* ExecutionEngine.t -> unit */
63CAMLprim value llvm_ee_dispose(LLVMExecutionEngineRef EE) {
64  LLVMDisposeExecutionEngine(EE);
65  return Val_unit;
66}
67
68/* llmodule -> ExecutionEngine.t -> unit */
69CAMLprim value llvm_ee_add_module(LLVMModuleRef M, LLVMExecutionEngineRef EE) {
70  LLVMAddModule(EE, M);
71  return Val_unit;
72}
73
74/* llmodule -> ExecutionEngine.t -> llmodule */
75CAMLprim value llvm_ee_remove_module(LLVMModuleRef M, LLVMExecutionEngineRef EE) {
76  LLVMModuleRef RemovedModule;
77  char *Error;
78  if (LLVMRemoveModule(EE, M, &RemovedModule, &Error))
79    llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
80  return Val_unit;
81}
82
83/* ExecutionEngine.t -> unit */
84CAMLprim value llvm_ee_run_static_ctors(LLVMExecutionEngineRef EE) {
85  LLVMRunStaticConstructors(EE);
86  return Val_unit;
87}
88
89/* ExecutionEngine.t -> unit */
90CAMLprim value llvm_ee_run_static_dtors(LLVMExecutionEngineRef EE) {
91  LLVMRunStaticDestructors(EE);
92  return Val_unit;
93}
94
95extern value llvm_alloc_data_layout(LLVMTargetDataRef TargetData);
96
97/* ExecutionEngine.t -> Llvm_target.DataLayout.t */
98CAMLprim value llvm_ee_get_data_layout(LLVMExecutionEngineRef EE) {
99  value DataLayout;
100  LLVMTargetDataRef OrigDataLayout;
101  char* TargetDataCStr;
102
103  OrigDataLayout = LLVMGetExecutionEngineTargetData(EE);
104  TargetDataCStr = LLVMCopyStringRepOfTargetData(OrigDataLayout);
105  DataLayout = llvm_alloc_data_layout(LLVMCreateTargetData(TargetDataCStr));
106  LLVMDisposeMessage(TargetDataCStr);
107
108  return DataLayout;
109}
110
111/* Llvm.llvalue -> int64 -> llexecutionengine -> unit */
112CAMLprim value llvm_ee_add_global_mapping(LLVMValueRef Global, value Ptr,
113                                          LLVMExecutionEngineRef EE) {
114  LLVMAddGlobalMapping(EE, Global, (void*) (Int64_val(Ptr)));
115  return Val_unit;
116}
117
118CAMLprim value llvm_ee_get_global_value_address(value Name,
119						LLVMExecutionEngineRef EE) {
120  return caml_copy_int64((int64_t) LLVMGetGlobalValueAddress(EE, String_val(Name)));
121}
122
123CAMLprim value llvm_ee_get_function_address(value Name,
124					    LLVMExecutionEngineRef EE) {
125  return caml_copy_int64((int64_t) LLVMGetFunctionAddress(EE, String_val(Name)));
126}
127