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