bindings/ocaml/executionengine/executionengine_ocaml.c

   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 "llvm-c/ExecutionEngine.h"
  19 #include "llvm-c/Target.h"
  20 #include "caml/alloc.h"
  21 #include "caml/custom.h"
  22 #include "caml/fail.h"
  23 #include "caml/memory.h"
  24 #include <string.h>
  25 #include <assert.h>
  26
  27 /* Force the LLVM interpreter and JIT to be linked in. */
  28 void llvm_initialize(void) {
  29   LLVMLinkInInterpreter();
  30   LLVMLinkInMCJIT();
  31 }
  32
  33 /* unit -> bool */
  34 CAMLprim value llvm_initialize_native_target(value Unit) {
  35   return Val_bool(!LLVMInitializeNativeTarget() &&
  36                   !LLVMInitializeNativeAsmParser() &&
  37                   !LLVMInitializeNativeAsmPrinter());
  38 }
  39
  40 /* Can't use the recommended caml_named_value mechanism for backwards
  41    compatibility reasons. This is largely equivalent. */
  42 static value llvm_ee_error_exn;
  43
  44 CAMLprim value llvm_register_ee_exns(value Error) {
  45   llvm_ee_error_exn = Field(Error, 0);
  46   register_global_root(&llvm_ee_error_exn);
  47   return Val_unit;
  48 }
  49
  50 static void llvm_raise(value Prototype, char *Message) {
  51   CAMLparam1(Prototype);
  52   CAMLlocal1(CamlMessage);
  53
  54   CamlMessage = copy_string(Message);
  55   LLVMDisposeMessage(Message);
  56
  57   raise_with_arg(Prototype, CamlMessage);
  58   abort(); /* NOTREACHED */
  59 #ifdef CAMLnoreturn
  60   CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
  61 #endif
  62 }
  63
  64
  65 /*--... Operations on generic values .......................................--*/
  66
  67 #define Genericvalue_val(v)  (*(LLVMGenericValueRef *)(Data_custom_val(v)))
  68
  69 static void llvm_finalize_generic_value(value GenVal) {
  70   LLVMDisposeGenericValue(Genericvalue_val(GenVal));
  71 }
  72
  73 static struct custom_operations generic_value_ops = {
  74   (char *) "LLVMGenericValue",
  75   llvm_finalize_generic_value,
  76   custom_compare_default,
  77   custom_hash_default,
  78   custom_serialize_default,
  79   custom_deserialize_default
  80 #ifdef custom_compare_ext_default
  81   , custom_compare_ext_default
  82 #endif
  83 };
  84
  85 static value alloc_generic_value(LLVMGenericValueRef Ref) {
  86   value Val = alloc_custom(&generic_value_ops, sizeof(LLVMGenericValueRef), 0, 1);
  87   Genericvalue_val(Val) = Ref;
  88   return Val;
  89 }
  90
  91 /* Llvm.lltype -> float -> t */
  92 CAMLprim value llvm_genericvalue_of_float(LLVMTypeRef Ty, value N) {
  93   CAMLparam1(N);
  94   CAMLreturn(alloc_generic_value(
  95     LLVMCreateGenericValueOfFloat(Ty, Double_val(N))));
  96 }
  97
  98 /* 'a -> t */
  99 CAMLprim value llvm_genericvalue_of_pointer(value V) {
 100   CAMLparam1(V);
 101   CAMLreturn(alloc_generic_value(LLVMCreateGenericValueOfPointer(Op_val(V))));
 102 }
 103
 104 /* Llvm.lltype -> int -> t */
 105 CAMLprim value llvm_genericvalue_of_int(LLVMTypeRef Ty, value Int) {
 106   return alloc_generic_value(LLVMCreateGenericValueOfInt(Ty, Int_val(Int), 1));
 107 }
 108
 109 /* Llvm.lltype -> int32 -> t */
 110 CAMLprim value llvm_genericvalue_of_int32(LLVMTypeRef Ty, value Int32) {
 111   CAMLparam1(Int32);
 112   CAMLreturn(alloc_generic_value(
 113     LLVMCreateGenericValueOfInt(Ty, Int32_val(Int32), 1)));
 114 }
 115
 116 /* Llvm.lltype -> nativeint -> t */
 117 CAMLprim value llvm_genericvalue_of_nativeint(LLVMTypeRef Ty, value NatInt) {
 118   CAMLparam1(NatInt);
 119   CAMLreturn(alloc_generic_value(
 120     LLVMCreateGenericValueOfInt(Ty, Nativeint_val(NatInt), 1)));
 121 }
 122
 123 /* Llvm.lltype -> int64 -> t */
 124 CAMLprim value llvm_genericvalue_of_int64(LLVMTypeRef Ty, value Int64) {
 125   CAMLparam1(Int64);
 126   CAMLreturn(alloc_generic_value(
 127     LLVMCreateGenericValueOfInt(Ty, Int64_val(Int64), 1)));
 128 }
 129
 130 /* Llvm.lltype -> t -> float */
 131 CAMLprim value llvm_genericvalue_as_float(LLVMTypeRef Ty, value GenVal) {
 132   CAMLparam1(GenVal);
 133   CAMLreturn(copy_double(
 134     LLVMGenericValueToFloat(Ty, Genericvalue_val(GenVal))));
 135 }
 136
 137 /* t -> 'a */
 138 CAMLprim value llvm_genericvalue_as_pointer(value GenVal) {
 139   return Val_op(LLVMGenericValueToPointer(Genericvalue_val(GenVal)));
 140 }
 141
 142 /* t -> int */
 143 CAMLprim value llvm_genericvalue_as_int(value GenVal) {
 144   assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 8 * sizeof(value)
 145          && "Generic value too wide to treat as an int!");
 146   return Val_int(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1));
 147 }
 148
 149 /* t -> int32 */
 150 CAMLprim value llvm_genericvalue_as_int32(value GenVal) {
 151   CAMLparam1(GenVal);
 152   assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 32
 153          && "Generic value too wide to treat as an int32!");
 154   CAMLreturn(copy_int32(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)));
 155 }
 156
 157 /* t -> int64 */
 158 CAMLprim value llvm_genericvalue_as_int64(value GenVal) {
 159   CAMLparam1(GenVal);
 160   assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 64
 161          && "Generic value too wide to treat as an int64!");
 162   CAMLreturn(copy_int64(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)));
 163 }
 164
 165 /* t -> nativeint */
 166 CAMLprim value llvm_genericvalue_as_nativeint(value GenVal) {
 167   CAMLparam1(GenVal);
 168   assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 8 * sizeof(value)
 169          && "Generic value too wide to treat as a nativeint!");
 170   CAMLreturn(copy_nativeint(LLVMGenericValueToInt(Genericvalue_val(GenVal),1)));
 171 }
 172
 173
 174 /*--... Operations on execution engines ....................................--*/
 175
 176 /* llmodule -> ExecutionEngine.t */
 177 CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleRef M) {
 178   LLVMExecutionEngineRef Interp;
 179   char *Error;
 180   if (LLVMCreateExecutionEngineForModule(&Interp, M, &Error))
 181     llvm_raise(llvm_ee_error_exn, Error);
 182   return Interp;
 183 }
 184
 185 /* llmodule -> ExecutionEngine.t */
 186 CAMLprim LLVMExecutionEngineRef
 187 llvm_ee_create_interpreter(LLVMModuleRef M) {
 188   LLVMExecutionEngineRef Interp;
 189   char *Error;
 190   if (LLVMCreateInterpreterForModule(&Interp, M, &Error))
 191     llvm_raise(llvm_ee_error_exn, Error);
 192   return Interp;
 193 }
 194
 195 /* llmodule -> int -> ExecutionEngine.t */
 196 CAMLprim LLVMExecutionEngineRef
 197 llvm_ee_create_jit(LLVMModuleRef M, value OptLevel) {
 198   LLVMExecutionEngineRef JIT;
 199   char *Error;
 200   if (LLVMCreateJITCompilerForModule(&JIT, M, Int_val(OptLevel), &Error))
 201     llvm_raise(llvm_ee_error_exn, Error);
 202   return JIT;
 203 }
 204
 205 /* llmodule -> llcompileroption -> ExecutionEngine.t */
 206 CAMLprim LLVMExecutionEngineRef
 207 llvm_ee_create_mcjit(LLVMModuleRef M, value OptRecord) {
 208   LLVMExecutionEngineRef MCJIT;
 209   char *Error;
 210   struct LLVMMCJITCompilerOptions Options = {
 211          .OptLevel = Int_val(Field(OptRecord, 0)),
 212          .CodeModel = Int_val(Field(OptRecord, 1)),
 213          .NoFramePointerElim = Int_val(Field(OptRecord, 2)),
 214          .EnableFastISel = Int_val(Field(OptRecord, 3)),
 215          .MCJMM = NULL
 216   };
 217   if (LLVMCreateMCJITCompilerForModule(&MCJIT, M, &Options,
 218                                       sizeof(Options), &Error))
 219     llvm_raise(llvm_ee_error_exn, Error);
 220   return MCJIT;
 221 }
 222
 223 /* ExecutionEngine.t -> unit */
 224 CAMLprim value llvm_ee_dispose(LLVMExecutionEngineRef EE) {
 225   LLVMDisposeExecutionEngine(EE);
 226   return Val_unit;
 227 }
 228
 229 /* llmodule -> ExecutionEngine.t -> unit */
 230 CAMLprim value llvm_ee_add_module(LLVMModuleRef M, LLVMExecutionEngineRef EE) {
 231   LLVMAddModule(EE, M);
 232   return Val_unit;
 233 }
 234
 235 /* llmodule -> ExecutionEngine.t -> llmodule */
 236 CAMLprim LLVMModuleRef llvm_ee_remove_module(LLVMModuleRef M,
 237                                              LLVMExecutionEngineRef EE) {
 238   LLVMModuleRef RemovedModule;
 239   char *Error;
 240   if (LLVMRemoveModule(EE, M, &RemovedModule, &Error))
 241     llvm_raise(llvm_ee_error_exn, Error);
 242   return RemovedModule;
 243 }
 244
 245 /* string -> ExecutionEngine.t -> llvalue option */
 246 CAMLprim value llvm_ee_find_function(value Name, LLVMExecutionEngineRef EE) {
 247   CAMLparam1(Name);
 248   CAMLlocal1(Option);
 249   LLVMValueRef Found;
 250   if (LLVMFindFunction(EE, String_val(Name), &Found))
 251     CAMLreturn(Val_unit);
 252   Option = alloc(1, 0);
 253   Field(Option, 0) = Val_op(Found);
 254   CAMLreturn(Option);
 255 }
 256
 257 /* llvalue -> GenericValue.t array -> ExecutionEngine.t -> GenericValue.t */
 258 CAMLprim value llvm_ee_run_function(LLVMValueRef F, value Args,
 259                                     LLVMExecutionEngineRef EE) {
 260   unsigned NumArgs;
 261   LLVMGenericValueRef Result, *GVArgs;
 262   unsigned I;
 263
 264   NumArgs = Wosize_val(Args);
 265   GVArgs = (LLVMGenericValueRef*) malloc(NumArgs * sizeof(LLVMGenericValueRef));
 266   for (I = 0; I != NumArgs; ++I)
 267     GVArgs[I] = Genericvalue_val(Field(Args, I));
 268
 269   Result = LLVMRunFunction(EE, F, NumArgs, GVArgs);
 270
 271   free(GVArgs);
 272   return alloc_generic_value(Result);
 273 }
 274
 275 /* ExecutionEngine.t -> unit */
 276 CAMLprim value llvm_ee_run_static_ctors(LLVMExecutionEngineRef EE) {
 277   LLVMRunStaticConstructors(EE);
 278   return Val_unit;
 279 }
 280
 281 /* ExecutionEngine.t -> unit */
 282 CAMLprim value llvm_ee_run_static_dtors(LLVMExecutionEngineRef EE) {
 283   LLVMRunStaticDestructors(EE);
 284   return Val_unit;
 285 }
 286
 287 /* llvalue -> string array -> (string * string) array -> ExecutionEngine.t ->
 288    int */
 289 CAMLprim value llvm_ee_run_function_as_main(LLVMValueRef F,
 290                                             value Args, value Env,
 291                                             LLVMExecutionEngineRef EE) {
 292   CAMLparam2(Args, Env);
 293   int I, NumArgs, NumEnv, EnvSize, Result;
 294   const char **CArgs, **CEnv;
 295   char *CEnvBuf, *Pos;
 296
 297   NumArgs = Wosize_val(Args);
 298   NumEnv = Wosize_val(Env);
 299
 300   /* Build the environment. */
 301   CArgs = (const char **) malloc(NumArgs * sizeof(char*));
 302   for (I = 0; I != NumArgs; ++I)
 303     CArgs[I] = String_val(Field(Args, I));
 304
 305   /* Compute the size of the environment string buffer. */
 306   for (I = 0, EnvSize = 0; I != NumEnv; ++I) {
 307     EnvSize += strlen(String_val(Field(Field(Env, I), 0))) + 1;
 308     EnvSize += strlen(String_val(Field(Field(Env, I), 1))) + 1;
 309   }
 310
 311   /* Build the environment. */
 312   CEnv = (const char **) malloc((NumEnv + 1) * sizeof(char*));
 313   CEnvBuf = (char*) malloc(EnvSize);
 314   Pos = CEnvBuf;
 315   for (I = 0; I != NumEnv; ++I) {
 316     char *Name  = String_val(Field(Field(Env, I), 0)),
 317          *Value = String_val(Field(Field(Env, I), 1));
 318     int NameLen  = strlen(Name),
 319         ValueLen = strlen(Value);
 320
 321     CEnv[I] = Pos;
 322     memcpy(Pos, Name, NameLen);
 323     Pos += NameLen;
 324     *Pos++ = '=';
 325     memcpy(Pos, Value, ValueLen);
 326     Pos += ValueLen;
 327     *Pos++ = '\0';
 328   }
 329   CEnv[NumEnv] = NULL;
 330
 331   Result = LLVMRunFunctionAsMain(EE, F, NumArgs, CArgs, CEnv);
 332
 333   free(CArgs);
 334   free(CEnv);
 335   free(CEnvBuf);
 336
 337   CAMLreturn(Val_int(Result));
 338 }
 339
 340 /* llvalue -> ExecutionEngine.t -> unit */
 341 CAMLprim value llvm_ee_free_machine_code(LLVMValueRef F,
 342                                          LLVMExecutionEngineRef EE) {
 343   LLVMFreeMachineCodeForFunction(EE, F);
 344   return Val_unit;
 345 }
 346
 347 extern value llvm_alloc_data_layout(LLVMTargetDataRef TargetData);
 348
 349 /* ExecutionEngine.t -> Llvm_target.DataLayout.t */
 350 CAMLprim value llvm_ee_get_data_layout(LLVMExecutionEngineRef EE) {
 351   value DataLayout;
 352   LLVMTargetDataRef OrigDataLayout;
 353   OrigDataLayout = LLVMGetExecutionEngineTargetData(EE);
 354
 355   char* TargetDataCStr;
 356   TargetDataCStr = LLVMCopyStringRepOfTargetData(OrigDataLayout);
 357   DataLayout = llvm_alloc_data_layout(LLVMCreateTargetData(TargetDataCStr));
 358   LLVMDisposeMessage(TargetDataCStr);
 359
 360   return DataLayout;
 361 }