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 };
     79 
     80 static value alloc_generic_value(LLVMGenericValueRef Ref) {
     81   value Val = alloc_custom(&generic_value_ops, sizeof(LLVMGenericValueRef), 0, 1);
     82   Genericvalue_val(Val) = Ref;
     83   return Val;
     84 }
     85 
     86 /* Llvm.lltype -> float -> t */
     87 CAMLprim value llvm_genericvalue_of_float(LLVMTypeRef Ty, value N) {
     88   CAMLparam1(N);
     89   CAMLreturn(alloc_generic_value(
     90     LLVMCreateGenericValueOfFloat(Ty, Double_val(N))));
     91 }
     92 
     93 /* 'a -> t */
     94 CAMLprim value llvm_genericvalue_of_pointer(value V) {
     95   CAMLparam1(V);
     96   CAMLreturn(alloc_generic_value(LLVMCreateGenericValueOfPointer(Op_val(V))));
     97 }
     98 
     99 /* Llvm.lltype -> int -> t */
    100 CAMLprim value llvm_genericvalue_of_int(LLVMTypeRef Ty, value Int) {
    101   return alloc_generic_value(LLVMCreateGenericValueOfInt(Ty, Int_val(Int), 1));
    102 }
    103 
    104 /* Llvm.lltype -> int32 -> t */
    105 CAMLprim value llvm_genericvalue_of_int32(LLVMTypeRef Ty, value Int32) {
    106   CAMLparam1(Int32);
    107   CAMLreturn(alloc_generic_value(
    108     LLVMCreateGenericValueOfInt(Ty, Int32_val(Int32), 1)));
    109 }
    110 
    111 /* Llvm.lltype -> nativeint -> t */
    112 CAMLprim value llvm_genericvalue_of_nativeint(LLVMTypeRef Ty, value NatInt) {
    113   CAMLparam1(NatInt);
    114   CAMLreturn(alloc_generic_value(
    115     LLVMCreateGenericValueOfInt(Ty, Nativeint_val(NatInt), 1)));
    116 }
    117 
    118 /* Llvm.lltype -> int64 -> t */
    119 CAMLprim value llvm_genericvalue_of_int64(LLVMTypeRef Ty, value Int64) {
    120   CAMLparam1(Int64);
    121   CAMLreturn(alloc_generic_value(
    122     LLVMCreateGenericValueOfInt(Ty, Int64_val(Int64), 1)));
    123 }
    124 
    125 /* Llvm.lltype -> t -> float */
    126 CAMLprim value llvm_genericvalue_as_float(LLVMTypeRef Ty, value GenVal) {
    127   CAMLparam1(GenVal);
    128   CAMLreturn(copy_double(
    129     LLVMGenericValueToFloat(Ty, Genericvalue_val(GenVal))));
    130 }
    131 
    132 /* t -> 'a */
    133 CAMLprim value llvm_genericvalue_as_pointer(value GenVal) {
    134   return Val_op(LLVMGenericValueToPointer(Genericvalue_val(GenVal)));
    135 }
    136 
    137 /* t -> int */
    138 CAMLprim value llvm_genericvalue_as_int(value GenVal) {
    139   assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 8 * sizeof(value)
    140          && "Generic value too wide to treat as an int!");
    141   return Val_int(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1));
    142 }
    143 
    144 /* t -> int32 */
    145 CAMLprim value llvm_genericvalue_as_int32(value GenVal) {
    146   CAMLparam1(GenVal);
    147   assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 32
    148          && "Generic value too wide to treat as an int32!");
    149   CAMLreturn(copy_int32(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)));
    150 }
    151 
    152 /* t -> int64 */
    153 CAMLprim value llvm_genericvalue_as_int64(value GenVal) {
    154   CAMLparam1(GenVal);
    155   assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 64
    156          && "Generic value too wide to treat as an int64!");
    157   CAMLreturn(copy_int64(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)));
    158 }
    159 
    160 /* t -> nativeint */
    161 CAMLprim value llvm_genericvalue_as_nativeint(value GenVal) {
    162   CAMLparam1(GenVal);
    163   assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 8 * sizeof(value)
    164          && "Generic value too wide to treat as a nativeint!");
    165   CAMLreturn(copy_nativeint(LLVMGenericValueToInt(Genericvalue_val(GenVal),1)));
    166 }
    167 
    168 
    169 /*--... Operations on execution engines ....................................--*/
    170 
    171 /* llmodule -> ExecutionEngine.t */
    172 CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleRef M) {
    173   LLVMExecutionEngineRef Interp;
    174   char *Error;
    175   if (LLVMCreateExecutionEngineForModule(&Interp, M, &Error))
    176     llvm_raise(llvm_ee_error_exn, Error);
    177   return Interp;
    178 }
    179 
    180 /* llmodule -> ExecutionEngine.t */
    181 CAMLprim LLVMExecutionEngineRef
    182 llvm_ee_create_interpreter(LLVMModuleRef M) {
    183   LLVMExecutionEngineRef Interp;
    184   char *Error;
    185   if (LLVMCreateInterpreterForModule(&Interp, M, &Error))
    186     llvm_raise(llvm_ee_error_exn, Error);
    187   return Interp;
    188 }
    189 
    190 /* llmodule -> int -> ExecutionEngine.t */
    191 CAMLprim LLVMExecutionEngineRef
    192 llvm_ee_create_jit(LLVMModuleRef M, value OptLevel) {
    193   LLVMExecutionEngineRef JIT;
    194   char *Error;
    195   if (LLVMCreateJITCompilerForModule(&JIT, M, Int_val(OptLevel), &Error))
    196     llvm_raise(llvm_ee_error_exn, Error);
    197   return JIT;
    198 }
    199 
    200 /* ExecutionEngine.t -> unit */
    201 CAMLprim value llvm_ee_dispose(LLVMExecutionEngineRef EE) {
    202   LLVMDisposeExecutionEngine(EE);
    203   return Val_unit;
    204 }
    205 
    206 /* llmodule -> ExecutionEngine.t -> unit */
    207 CAMLprim value llvm_ee_add_module(LLVMModuleRef M, LLVMExecutionEngineRef EE) {
    208   LLVMAddModule(EE, M);
    209   return Val_unit;
    210 }
    211 
    212 /* llmodule -> ExecutionEngine.t -> llmodule */
    213 CAMLprim LLVMModuleRef llvm_ee_remove_module(LLVMModuleRef M,
    214                                              LLVMExecutionEngineRef EE) {
    215   LLVMModuleRef RemovedModule;
    216   char *Error;
    217   if (LLVMRemoveModule(EE, M, &RemovedModule, &Error))
    218     llvm_raise(llvm_ee_error_exn, Error);
    219   return RemovedModule;
    220 }
    221 
    222 /* string -> ExecutionEngine.t -> llvalue option */
    223 CAMLprim value llvm_ee_find_function(value Name, LLVMExecutionEngineRef EE) {
    224   CAMLparam1(Name);
    225   CAMLlocal1(Option);
    226   LLVMValueRef Found;
    227   if (LLVMFindFunction(EE, String_val(Name), &Found))
    228     CAMLreturn(Val_unit);
    229   Option = alloc(1, 0);
    230   Field(Option, 0) = Val_op(Found);
    231   CAMLreturn(Option);
    232 }
    233 
    234 /* llvalue -> GenericValue.t array -> ExecutionEngine.t -> GenericValue.t */
    235 CAMLprim value llvm_ee_run_function(LLVMValueRef F, value Args,
    236                                     LLVMExecutionEngineRef EE) {
    237   unsigned NumArgs;
    238   LLVMGenericValueRef Result, *GVArgs;
    239   unsigned I;
    240 
    241   NumArgs = Wosize_val(Args);
    242   GVArgs = (LLVMGenericValueRef*) malloc(NumArgs * sizeof(LLVMGenericValueRef));
    243   for (I = 0; I != NumArgs; ++I)
    244     GVArgs[I] = Genericvalue_val(Field(Args, I));
    245 
    246   Result = LLVMRunFunction(EE, F, NumArgs, GVArgs);
    247 
    248   free(GVArgs);
    249   return alloc_generic_value(Result);
    250 }
    251 
    252 /* ExecutionEngine.t -> unit */
    253 CAMLprim value llvm_ee_run_static_ctors(LLVMExecutionEngineRef EE) {
    254   LLVMRunStaticConstructors(EE);
    255   return Val_unit;
    256 }
    257 
    258 /* ExecutionEngine.t -> unit */
    259 CAMLprim value llvm_ee_run_static_dtors(LLVMExecutionEngineRef EE) {
    260   LLVMRunStaticDestructors(EE);
    261   return Val_unit;
    262 }
    263 
    264 /* llvalue -> string array -> (string * string) array -> ExecutionEngine.t ->
    265    int */
    266 CAMLprim value llvm_ee_run_function_as_main(LLVMValueRef F,
    267                                             value Args, value Env,
    268                                             LLVMExecutionEngineRef EE) {
    269   CAMLparam2(Args, Env);
    270   int I, NumArgs, NumEnv, EnvSize, Result;
    271   const char **CArgs, **CEnv;
    272   char *CEnvBuf, *Pos;
    273 
    274   NumArgs = Wosize_val(Args);
    275   NumEnv = Wosize_val(Env);
    276 
    277   /* Build the environment. */
    278   CArgs = (const char **) malloc(NumArgs * sizeof(char*));
    279   for (I = 0; I != NumArgs; ++I)
    280     CArgs[I] = String_val(Field(Args, I));
    281 
    282   /* Compute the size of the environment string buffer. */
    283   for (I = 0, EnvSize = 0; I != NumEnv; ++I) {
    284     EnvSize += strlen(String_val(Field(Field(Env, I), 0))) + 1;
    285     EnvSize += strlen(String_val(Field(Field(Env, I), 1))) + 1;
    286   }
    287 
    288   /* Build the environment. */
    289   CEnv = (const char **) malloc((NumEnv + 1) * sizeof(char*));
    290   CEnvBuf = (char*) malloc(EnvSize);
    291   Pos = CEnvBuf;
    292   for (I = 0; I != NumEnv; ++I) {
    293     char *Name  = String_val(Field(Field(Env, I), 0)),
    294          *Value = String_val(Field(Field(Env, I), 1));
    295     int NameLen  = strlen(Name),
    296         ValueLen = strlen(Value);
    297 
    298     CEnv[I] = Pos;
    299     memcpy(Pos, Name, NameLen);
    300     Pos += NameLen;
    301     *Pos++ = '=';
    302     memcpy(Pos, Value, ValueLen);
    303     Pos += ValueLen;
    304     *Pos++ = '\0';
    305   }
    306   CEnv[NumEnv] = NULL;
    307 
    308   Result = LLVMRunFunctionAsMain(EE, F, NumArgs, CArgs, CEnv);
    309 
    310   free(CArgs);
    311   free(CEnv);
    312   free(CEnvBuf);
    313 
    314   CAMLreturn(Val_int(Result));
    315 }
    316 
    317 /* llvalue -> ExecutionEngine.t -> unit */
    318 CAMLprim value llvm_ee_free_machine_code(LLVMValueRef F,
    319                                          LLVMExecutionEngineRef EE) {
    320   LLVMFreeMachineCodeForFunction(EE, F);
    321   return Val_unit;
    322 }
    323 
    324