/3rd_party/llvm/bindings/ocaml/executionengine/executionengine_ocaml.c

https://code.google.com/p/softart/ · C · 341 lines · 235 code · 55 blank · 51 comment · 17 complexity · b923d60b336262928a165d7e6ef24bb3 MD5 · raw file

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