/3rd_party/llvm/bindings/ocaml/llvm/llvm_ocaml.c

https://code.google.com/p/softart/ · C · 2235 lines · 1516 code · 378 blank · 341 comment · 51 complexity · 8d3240b7a20638d4bc091a0cef5caaf5 MD5 · raw file

Large files are truncated click here to view the full file

  1. /*===-- llvm_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/Core.h"
  18. #include "caml/alloc.h"
  19. #include "caml/custom.h"
  20. #include "caml/memory.h"
  21. #include "caml/fail.h"
  22. #include "caml/callback.h"
  23. #include <assert.h>
  24. #include <stdlib.h>
  25. #include <string.h>
  26. /* Can't use the recommended caml_named_value mechanism for backwards
  27. compatibility reasons. This is largely equivalent. */
  28. static value llvm_ioerror_exn;
  29. CAMLprim value llvm_register_core_exns(value IoError) {
  30. llvm_ioerror_exn = Field(IoError, 0);
  31. register_global_root(&llvm_ioerror_exn);
  32. return Val_unit;
  33. }
  34. static void llvm_raise(value Prototype, char *Message) {
  35. CAMLparam1(Prototype);
  36. CAMLlocal1(CamlMessage);
  37. CamlMessage = copy_string(Message);
  38. LLVMDisposeMessage(Message);
  39. raise_with_arg(Prototype, CamlMessage);
  40. abort(); /* NOTREACHED */
  41. #ifdef CAMLnoreturn
  42. CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
  43. #endif
  44. }
  45. static value llvm_fatal_error_handler;
  46. static void llvm_fatal_error_trampoline(const char *Reason) {
  47. callback(llvm_fatal_error_handler, copy_string(Reason));
  48. }
  49. CAMLprim value llvm_install_fatal_error_handler(value Handler) {
  50. LLVMInstallFatalErrorHandler(llvm_fatal_error_trampoline);
  51. llvm_fatal_error_handler = Handler;
  52. caml_register_global_root(&llvm_fatal_error_handler);
  53. return Val_unit;
  54. }
  55. CAMLprim value llvm_reset_fatal_error_handler(value Unit) {
  56. caml_remove_global_root(&llvm_fatal_error_handler);
  57. LLVMResetFatalErrorHandler();
  58. return Val_unit;
  59. }
  60. CAMLprim value llvm_enable_pretty_stacktrace(value Unit) {
  61. LLVMEnablePrettyStackTrace();
  62. return Val_unit;
  63. }
  64. static value alloc_variant(int tag, void *Value) {
  65. value Iter = alloc_small(1, tag);
  66. Field(Iter, 0) = Val_op(Value);
  67. return Iter;
  68. }
  69. /* Macro to convert the C first/next/last/prev idiom to the Ocaml llpos/
  70. llrev_pos idiom. */
  71. #define DEFINE_ITERATORS(camlname, cname, pty, cty, pfun) \
  72. /* llmodule -> ('a, 'b) llpos */ \
  73. CAMLprim value llvm_##camlname##_begin(pty Mom) { \
  74. cty First = LLVMGetFirst##cname(Mom); \
  75. if (First) \
  76. return alloc_variant(1, First); \
  77. return alloc_variant(0, Mom); \
  78. } \
  79. \
  80. /* llvalue -> ('a, 'b) llpos */ \
  81. CAMLprim value llvm_##camlname##_succ(cty Kid) { \
  82. cty Next = LLVMGetNext##cname(Kid); \
  83. if (Next) \
  84. return alloc_variant(1, Next); \
  85. return alloc_variant(0, pfun(Kid)); \
  86. } \
  87. \
  88. /* llmodule -> ('a, 'b) llrev_pos */ \
  89. CAMLprim value llvm_##camlname##_end(pty Mom) { \
  90. cty Last = LLVMGetLast##cname(Mom); \
  91. if (Last) \
  92. return alloc_variant(1, Last); \
  93. return alloc_variant(0, Mom); \
  94. } \
  95. \
  96. /* llvalue -> ('a, 'b) llrev_pos */ \
  97. CAMLprim value llvm_##camlname##_pred(cty Kid) { \
  98. cty Prev = LLVMGetPrevious##cname(Kid); \
  99. if (Prev) \
  100. return alloc_variant(1, Prev); \
  101. return alloc_variant(0, pfun(Kid)); \
  102. }
  103. /*===-- Contexts ----------------------------------------------------------===*/
  104. /* unit -> llcontext */
  105. CAMLprim LLVMContextRef llvm_create_context(value Unit) {
  106. return LLVMContextCreate();
  107. }
  108. /* llcontext -> unit */
  109. CAMLprim value llvm_dispose_context(LLVMContextRef C) {
  110. LLVMContextDispose(C);
  111. return Val_unit;
  112. }
  113. /* unit -> llcontext */
  114. CAMLprim LLVMContextRef llvm_global_context(value Unit) {
  115. return LLVMGetGlobalContext();
  116. }
  117. /* llcontext -> string -> int */
  118. CAMLprim value llvm_mdkind_id(LLVMContextRef C, value Name) {
  119. unsigned MDKindID = LLVMGetMDKindIDInContext(C, String_val(Name),
  120. caml_string_length(Name));
  121. return Val_int(MDKindID);
  122. }
  123. /*===-- Modules -----------------------------------------------------------===*/
  124. /* llcontext -> string -> llmodule */
  125. CAMLprim LLVMModuleRef llvm_create_module(LLVMContextRef C, value ModuleID) {
  126. return LLVMModuleCreateWithNameInContext(String_val(ModuleID), C);
  127. }
  128. /* llmodule -> unit */
  129. CAMLprim value llvm_dispose_module(LLVMModuleRef M) {
  130. LLVMDisposeModule(M);
  131. return Val_unit;
  132. }
  133. /* llmodule -> string */
  134. CAMLprim value llvm_target_triple(LLVMModuleRef M) {
  135. return copy_string(LLVMGetTarget(M));
  136. }
  137. /* string -> llmodule -> unit */
  138. CAMLprim value llvm_set_target_triple(value Trip, LLVMModuleRef M) {
  139. LLVMSetTarget(M, String_val(Trip));
  140. return Val_unit;
  141. }
  142. /* llmodule -> string */
  143. CAMLprim value llvm_data_layout(LLVMModuleRef M) {
  144. return copy_string(LLVMGetDataLayout(M));
  145. }
  146. /* string -> llmodule -> unit */
  147. CAMLprim value llvm_set_data_layout(value Layout, LLVMModuleRef M) {
  148. LLVMSetDataLayout(M, String_val(Layout));
  149. return Val_unit;
  150. }
  151. /* llmodule -> unit */
  152. CAMLprim value llvm_dump_module(LLVMModuleRef M) {
  153. LLVMDumpModule(M);
  154. return Val_unit;
  155. }
  156. /* string -> llmodule -> unit */
  157. CAMLprim value llvm_print_module(value Filename, LLVMModuleRef M) {
  158. char* Message;
  159. if(LLVMPrintModuleToFile(M, String_val(Filename), &Message)) {
  160. llvm_raise(llvm_ioerror_exn, Message);
  161. }
  162. return Val_unit;
  163. }
  164. /* llmodule -> string */
  165. CAMLprim value llvm_string_of_llmodule(LLVMModuleRef M) {
  166. char* ModuleCStr;
  167. ModuleCStr = LLVMPrintModuleToString(M);
  168. value ModuleStr = caml_copy_string(ModuleCStr);
  169. LLVMDisposeMessage(ModuleCStr);
  170. return ModuleStr;
  171. }
  172. /* llmodule -> string -> unit */
  173. CAMLprim value llvm_set_module_inline_asm(LLVMModuleRef M, value Asm) {
  174. LLVMSetModuleInlineAsm(M, String_val(Asm));
  175. return Val_unit;
  176. }
  177. /*===-- Types -------------------------------------------------------------===*/
  178. /* lltype -> TypeKind.t */
  179. CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
  180. return Val_int(LLVMGetTypeKind(Ty));
  181. }
  182. CAMLprim value llvm_type_is_sized(LLVMTypeRef Ty) {
  183. return Val_bool(LLVMTypeIsSized(Ty));
  184. }
  185. /* lltype -> llcontext */
  186. CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) {
  187. return LLVMGetTypeContext(Ty);
  188. }
  189. /* lltype -> unit */
  190. CAMLprim value llvm_dump_type(LLVMTypeRef Val) {
  191. LLVMDumpType(Val);
  192. return Val_unit;
  193. }
  194. /* lltype -> string */
  195. CAMLprim value llvm_string_of_lltype(LLVMTypeRef M) {
  196. char* TypeCStr;
  197. TypeCStr = LLVMPrintTypeToString(M);
  198. value TypeStr = caml_copy_string(TypeCStr);
  199. LLVMDisposeMessage(TypeCStr);
  200. return TypeStr;
  201. }
  202. /*--... Operations on integer types ........................................--*/
  203. /* llcontext -> lltype */
  204. CAMLprim LLVMTypeRef llvm_i1_type (LLVMContextRef Context) {
  205. return LLVMInt1TypeInContext(Context);
  206. }
  207. /* llcontext -> lltype */
  208. CAMLprim LLVMTypeRef llvm_i8_type (LLVMContextRef Context) {
  209. return LLVMInt8TypeInContext(Context);
  210. }
  211. /* llcontext -> lltype */
  212. CAMLprim LLVMTypeRef llvm_i16_type (LLVMContextRef Context) {
  213. return LLVMInt16TypeInContext(Context);
  214. }
  215. /* llcontext -> lltype */
  216. CAMLprim LLVMTypeRef llvm_i32_type (LLVMContextRef Context) {
  217. return LLVMInt32TypeInContext(Context);
  218. }
  219. /* llcontext -> lltype */
  220. CAMLprim LLVMTypeRef llvm_i64_type (LLVMContextRef Context) {
  221. return LLVMInt64TypeInContext(Context);
  222. }
  223. /* llcontext -> int -> lltype */
  224. CAMLprim LLVMTypeRef llvm_integer_type(LLVMContextRef Context, value Width) {
  225. return LLVMIntTypeInContext(Context, Int_val(Width));
  226. }
  227. /* lltype -> int */
  228. CAMLprim value llvm_integer_bitwidth(LLVMTypeRef IntegerTy) {
  229. return Val_int(LLVMGetIntTypeWidth(IntegerTy));
  230. }
  231. /*--... Operations on real types ...........................................--*/
  232. /* llcontext -> lltype */
  233. CAMLprim LLVMTypeRef llvm_float_type(LLVMContextRef Context) {
  234. return LLVMFloatTypeInContext(Context);
  235. }
  236. /* llcontext -> lltype */
  237. CAMLprim LLVMTypeRef llvm_double_type(LLVMContextRef Context) {
  238. return LLVMDoubleTypeInContext(Context);
  239. }
  240. /* llcontext -> lltype */
  241. CAMLprim LLVMTypeRef llvm_x86fp80_type(LLVMContextRef Context) {
  242. return LLVMX86FP80TypeInContext(Context);
  243. }
  244. /* llcontext -> lltype */
  245. CAMLprim LLVMTypeRef llvm_fp128_type(LLVMContextRef Context) {
  246. return LLVMFP128TypeInContext(Context);
  247. }
  248. /* llcontext -> lltype */
  249. CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) {
  250. return LLVMPPCFP128TypeInContext(Context);
  251. }
  252. /*--... Operations on function types .......................................--*/
  253. /* lltype -> lltype array -> lltype */
  254. CAMLprim LLVMTypeRef llvm_function_type(LLVMTypeRef RetTy, value ParamTys) {
  255. return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
  256. Wosize_val(ParamTys), 0);
  257. }
  258. /* lltype -> lltype array -> lltype */
  259. CAMLprim LLVMTypeRef llvm_var_arg_function_type(LLVMTypeRef RetTy,
  260. value ParamTys) {
  261. return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
  262. Wosize_val(ParamTys), 1);
  263. }
  264. /* lltype -> bool */
  265. CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) {
  266. return Val_bool(LLVMIsFunctionVarArg(FunTy));
  267. }
  268. /* lltype -> lltype array */
  269. CAMLprim value llvm_param_types(LLVMTypeRef FunTy) {
  270. value Tys = alloc(LLVMCountParamTypes(FunTy), 0);
  271. LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys);
  272. return Tys;
  273. }
  274. /*--... Operations on struct types .........................................--*/
  275. /* llcontext -> lltype array -> lltype */
  276. CAMLprim LLVMTypeRef llvm_struct_type(LLVMContextRef C, value ElementTypes) {
  277. return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
  278. Wosize_val(ElementTypes), 0);
  279. }
  280. /* llcontext -> lltype array -> lltype */
  281. CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C,
  282. value ElementTypes) {
  283. return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
  284. Wosize_val(ElementTypes), 1);
  285. }
  286. /* llcontext -> string -> lltype */
  287. CAMLprim LLVMTypeRef llvm_named_struct_type(LLVMContextRef C,
  288. value Name) {
  289. return LLVMStructCreateNamed(C, String_val(Name));
  290. }
  291. CAMLprim value llvm_struct_set_body(LLVMTypeRef Ty,
  292. value ElementTypes,
  293. value Packed) {
  294. LLVMStructSetBody(Ty, (LLVMTypeRef *) ElementTypes,
  295. Wosize_val(ElementTypes), Bool_val(Packed));
  296. return Val_unit;
  297. }
  298. /* lltype -> string option */
  299. CAMLprim value llvm_struct_name(LLVMTypeRef Ty)
  300. {
  301. CAMLparam0();
  302. const char *C = LLVMGetStructName(Ty);
  303. if (C) {
  304. CAMLlocal1(result);
  305. result = caml_alloc_small(1, 0);
  306. Store_field(result, 0, caml_copy_string(C));
  307. CAMLreturn(result);
  308. }
  309. CAMLreturn(Val_int(0));
  310. }
  311. /* lltype -> lltype array */
  312. CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) {
  313. value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
  314. LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys);
  315. return Tys;
  316. }
  317. /* lltype -> bool */
  318. CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) {
  319. return Val_bool(LLVMIsPackedStruct(StructTy));
  320. }
  321. /* lltype -> bool */
  322. CAMLprim value llvm_is_opaque(LLVMTypeRef StructTy) {
  323. return Val_bool(LLVMIsOpaqueStruct(StructTy));
  324. }
  325. /*--... Operations on array, pointer, and vector types .....................--*/
  326. /* lltype -> int -> lltype */
  327. CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) {
  328. return LLVMArrayType(ElementTy, Int_val(Count));
  329. }
  330. /* lltype -> lltype */
  331. CAMLprim LLVMTypeRef llvm_pointer_type(LLVMTypeRef ElementTy) {
  332. return LLVMPointerType(ElementTy, 0);
  333. }
  334. /* lltype -> int -> lltype */
  335. CAMLprim LLVMTypeRef llvm_qualified_pointer_type(LLVMTypeRef ElementTy,
  336. value AddressSpace) {
  337. return LLVMPointerType(ElementTy, Int_val(AddressSpace));
  338. }
  339. /* lltype -> int -> lltype */
  340. CAMLprim LLVMTypeRef llvm_vector_type(LLVMTypeRef ElementTy, value Count) {
  341. return LLVMVectorType(ElementTy, Int_val(Count));
  342. }
  343. /* lltype -> int */
  344. CAMLprim value llvm_array_length(LLVMTypeRef ArrayTy) {
  345. return Val_int(LLVMGetArrayLength(ArrayTy));
  346. }
  347. /* lltype -> int */
  348. CAMLprim value llvm_address_space(LLVMTypeRef PtrTy) {
  349. return Val_int(LLVMGetPointerAddressSpace(PtrTy));
  350. }
  351. /* lltype -> int */
  352. CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) {
  353. return Val_int(LLVMGetVectorSize(VectorTy));
  354. }
  355. /*--... Operations on other types ..........................................--*/
  356. /* llcontext -> lltype */
  357. CAMLprim LLVMTypeRef llvm_void_type (LLVMContextRef Context) {
  358. return LLVMVoidTypeInContext(Context);
  359. }
  360. /* llcontext -> lltype */
  361. CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
  362. return LLVMLabelTypeInContext(Context);
  363. }
  364. /* llcontext -> lltype */
  365. CAMLprim LLVMTypeRef llvm_x86_mmx_type(LLVMContextRef Context) {
  366. return LLVMX86MMXTypeInContext(Context);
  367. }
  368. CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
  369. {
  370. CAMLparam1(Name);
  371. LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
  372. if (Ty) {
  373. value Option = alloc(1, 0);
  374. Field(Option, 0) = (value) Ty;
  375. CAMLreturn(Option);
  376. }
  377. CAMLreturn(Val_int(0));
  378. }
  379. /*===-- VALUES ------------------------------------------------------------===*/
  380. /* llvalue -> lltype */
  381. CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) {
  382. return LLVMTypeOf(Val);
  383. }
  384. /* keep in sync with ValueKind.t */
  385. enum ValueKind {
  386. NullValue=0,
  387. Argument,
  388. BasicBlock,
  389. InlineAsm,
  390. MDNode,
  391. MDString,
  392. BlockAddress,
  393. ConstantAggregateZero,
  394. ConstantArray,
  395. ConstantDataArray,
  396. ConstantDataVector,
  397. ConstantExpr,
  398. ConstantFP,
  399. ConstantInt,
  400. ConstantPointerNull,
  401. ConstantStruct,
  402. ConstantVector,
  403. Function,
  404. GlobalAlias,
  405. GlobalVariable,
  406. UndefValue,
  407. Instruction
  408. };
  409. /* llvalue -> ValueKind.t */
  410. #define DEFINE_CASE(Val, Kind) \
  411. do {if (LLVMIsA##Kind(Val)) CAMLreturn(Val_int(Kind));} while(0)
  412. CAMLprim value llvm_classify_value(LLVMValueRef Val) {
  413. CAMLparam0();
  414. if (!Val)
  415. CAMLreturn(Val_int(NullValue));
  416. if (LLVMIsAConstant(Val)) {
  417. DEFINE_CASE(Val, BlockAddress);
  418. DEFINE_CASE(Val, ConstantAggregateZero);
  419. DEFINE_CASE(Val, ConstantArray);
  420. DEFINE_CASE(Val, ConstantDataArray);
  421. DEFINE_CASE(Val, ConstantDataVector);
  422. DEFINE_CASE(Val, ConstantExpr);
  423. DEFINE_CASE(Val, ConstantFP);
  424. DEFINE_CASE(Val, ConstantInt);
  425. DEFINE_CASE(Val, ConstantPointerNull);
  426. DEFINE_CASE(Val, ConstantStruct);
  427. DEFINE_CASE(Val, ConstantVector);
  428. }
  429. if (LLVMIsAInstruction(Val)) {
  430. CAMLlocal1(result);
  431. result = caml_alloc_small(1, 0);
  432. Store_field(result, 0, Val_int(LLVMGetInstructionOpcode(Val)));
  433. CAMLreturn(result);
  434. }
  435. if (LLVMIsAGlobalValue(Val)) {
  436. DEFINE_CASE(Val, Function);
  437. DEFINE_CASE(Val, GlobalAlias);
  438. DEFINE_CASE(Val, GlobalVariable);
  439. }
  440. DEFINE_CASE(Val, Argument);
  441. DEFINE_CASE(Val, BasicBlock);
  442. DEFINE_CASE(Val, InlineAsm);
  443. DEFINE_CASE(Val, MDNode);
  444. DEFINE_CASE(Val, MDString);
  445. DEFINE_CASE(Val, UndefValue);
  446. failwith("Unknown Value class");
  447. }
  448. /* llvalue -> string */
  449. CAMLprim value llvm_value_name(LLVMValueRef Val) {
  450. return copy_string(LLVMGetValueName(Val));
  451. }
  452. /* string -> llvalue -> unit */
  453. CAMLprim value llvm_set_value_name(value Name, LLVMValueRef Val) {
  454. LLVMSetValueName(Val, String_val(Name));
  455. return Val_unit;
  456. }
  457. /* llvalue -> unit */
  458. CAMLprim value llvm_dump_value(LLVMValueRef Val) {
  459. LLVMDumpValue(Val);
  460. return Val_unit;
  461. }
  462. /* llvalue -> string */
  463. CAMLprim value llvm_string_of_llvalue(LLVMValueRef M) {
  464. char* ValueCStr;
  465. ValueCStr = LLVMPrintValueToString(M);
  466. value ValueStr = caml_copy_string(ValueCStr);
  467. LLVMDisposeMessage(ValueCStr);
  468. return ValueStr;
  469. }
  470. /* llvalue -> llvalue -> unit */
  471. CAMLprim value llvm_replace_all_uses_with(LLVMValueRef OldVal,
  472. LLVMValueRef NewVal) {
  473. LLVMReplaceAllUsesWith(OldVal, NewVal);
  474. return Val_unit;
  475. }
  476. /*--... Operations on users ................................................--*/
  477. /* llvalue -> int -> llvalue */
  478. CAMLprim LLVMValueRef llvm_operand(LLVMValueRef V, value I) {
  479. return LLVMGetOperand(V, Int_val(I));
  480. }
  481. /* llvalue -> int -> llvalue -> unit */
  482. CAMLprim value llvm_set_operand(LLVMValueRef U, value I, LLVMValueRef V) {
  483. LLVMSetOperand(U, Int_val(I), V);
  484. return Val_unit;
  485. }
  486. /* llvalue -> int */
  487. CAMLprim value llvm_num_operands(LLVMValueRef V) {
  488. return Val_int(LLVMGetNumOperands(V));
  489. }
  490. /*--... Operations on constants of (mostly) any type .......................--*/
  491. /* llvalue -> bool */
  492. CAMLprim value llvm_is_constant(LLVMValueRef Val) {
  493. return Val_bool(LLVMIsConstant(Val));
  494. }
  495. /* llvalue -> bool */
  496. CAMLprim value llvm_is_null(LLVMValueRef Val) {
  497. return Val_bool(LLVMIsNull(Val));
  498. }
  499. /* llvalue -> bool */
  500. CAMLprim value llvm_is_undef(LLVMValueRef Val) {
  501. return Val_bool(LLVMIsUndef(Val));
  502. }
  503. /* llvalue -> Opcode.t */
  504. CAMLprim value llvm_constexpr_get_opcode(LLVMValueRef Val) {
  505. return LLVMIsAConstantExpr(Val) ?
  506. Val_int(LLVMGetConstOpcode(Val)) : Val_int(0);
  507. }
  508. /*--... Operations on instructions .........................................--*/
  509. /* llvalue -> bool */
  510. CAMLprim value llvm_has_metadata(LLVMValueRef Val) {
  511. return Val_bool(LLVMHasMetadata(Val));
  512. }
  513. /* llvalue -> int -> llvalue option */
  514. CAMLprim value llvm_metadata(LLVMValueRef Val, value MDKindID) {
  515. CAMLparam1(MDKindID);
  516. LLVMValueRef MD;
  517. if ((MD = LLVMGetMetadata(Val, Int_val(MDKindID)))) {
  518. value Option = alloc(1, 0);
  519. Field(Option, 0) = (value) MD;
  520. CAMLreturn(Option);
  521. }
  522. CAMLreturn(Val_int(0));
  523. }
  524. /* llvalue -> int -> llvalue -> unit */
  525. CAMLprim value llvm_set_metadata(LLVMValueRef Val, value MDKindID,
  526. LLVMValueRef MD) {
  527. LLVMSetMetadata(Val, Int_val(MDKindID), MD);
  528. return Val_unit;
  529. }
  530. /* llvalue -> int -> unit */
  531. CAMLprim value llvm_clear_metadata(LLVMValueRef Val, value MDKindID) {
  532. LLVMSetMetadata(Val, Int_val(MDKindID), NULL);
  533. return Val_unit;
  534. }
  535. /*--... Operations on metadata .............................................--*/
  536. /* llcontext -> string -> llvalue */
  537. CAMLprim LLVMValueRef llvm_mdstring(LLVMContextRef C, value S) {
  538. return LLVMMDStringInContext(C, String_val(S), caml_string_length(S));
  539. }
  540. /* llcontext -> llvalue array -> llvalue */
  541. CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) {
  542. return LLVMMDNodeInContext(C, (LLVMValueRef*) Op_val(ElementVals),
  543. Wosize_val(ElementVals));
  544. }
  545. /* llvalue -> string option */
  546. CAMLprim value llvm_get_mdstring(LLVMValueRef V) {
  547. CAMLparam0();
  548. const char *S;
  549. unsigned Len;
  550. if ((S = LLVMGetMDString(V, &Len))) {
  551. CAMLlocal2(Option, Str);
  552. Str = caml_alloc_string(Len);
  553. memcpy(String_val(Str), S, Len);
  554. Option = alloc(1,0);
  555. Store_field(Option, 0, Str);
  556. CAMLreturn(Option);
  557. }
  558. CAMLreturn(Val_int(0));
  559. }
  560. /* llmodule -> string -> llvalue array */
  561. CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value Name)
  562. {
  563. CAMLparam1(Name);
  564. CAMLlocal1(Nodes);
  565. Nodes = alloc(LLVMGetNamedMetadataNumOperands(M, String_val(Name)), 0);
  566. LLVMGetNamedMetadataOperands(M, String_val(Name), (LLVMValueRef *) Nodes);
  567. CAMLreturn(Nodes);
  568. }
  569. /* llmodule -> string -> llvalue -> unit */
  570. CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef Val) {
  571. LLVMAddNamedMetadataOperand(M, String_val(Name), Val);
  572. return Val_unit;
  573. }
  574. /*--... Operations on scalar constants .....................................--*/
  575. /* lltype -> int -> llvalue */
  576. CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) {
  577. return LLVMConstInt(IntTy, (long long) Int_val(N), 1);
  578. }
  579. /* lltype -> Int64.t -> bool -> llvalue */
  580. CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
  581. value SExt) {
  582. return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
  583. }
  584. /* llvalue -> Int64.t */
  585. CAMLprim value llvm_int64_of_const(LLVMValueRef Const)
  586. {
  587. CAMLparam0();
  588. if (LLVMIsAConstantInt(Const) &&
  589. LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64) {
  590. value Option = alloc(1, 0);
  591. Field(Option, 0) = caml_copy_int64(LLVMConstIntGetSExtValue(Const));
  592. CAMLreturn(Option);
  593. }
  594. CAMLreturn(Val_int(0));
  595. }
  596. /* lltype -> string -> int -> llvalue */
  597. CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
  598. value Radix) {
  599. return LLVMConstIntOfStringAndSize(IntTy, String_val(S), caml_string_length(S),
  600. Int_val(Radix));
  601. }
  602. /* lltype -> float -> llvalue */
  603. CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) {
  604. return LLVMConstReal(RealTy, Double_val(N));
  605. }
  606. /* lltype -> string -> llvalue */
  607. CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) {
  608. return LLVMConstRealOfStringAndSize(RealTy, String_val(S),
  609. caml_string_length(S));
  610. }
  611. /*--... Operations on composite constants ..................................--*/
  612. /* llcontext -> string -> llvalue */
  613. CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str,
  614. value NullTerminate) {
  615. return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
  616. 1);
  617. }
  618. /* llcontext -> string -> llvalue */
  619. CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str,
  620. value NullTerminate) {
  621. return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
  622. 0);
  623. }
  624. /* lltype -> llvalue array -> llvalue */
  625. CAMLprim LLVMValueRef llvm_const_array(LLVMTypeRef ElementTy,
  626. value ElementVals) {
  627. return LLVMConstArray(ElementTy, (LLVMValueRef*) Op_val(ElementVals),
  628. Wosize_val(ElementVals));
  629. }
  630. /* llcontext -> llvalue array -> llvalue */
  631. CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) {
  632. return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
  633. Wosize_val(ElementVals), 0);
  634. }
  635. /* lltype -> llvalue array -> llvalue */
  636. CAMLprim LLVMValueRef llvm_const_named_struct(LLVMTypeRef Ty, value ElementVals) {
  637. return LLVMConstNamedStruct(Ty, (LLVMValueRef *) Op_val(ElementVals), Wosize_val(ElementVals));
  638. }
  639. /* llcontext -> llvalue array -> llvalue */
  640. CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C,
  641. value ElementVals) {
  642. return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
  643. Wosize_val(ElementVals), 1);
  644. }
  645. /* llvalue array -> llvalue */
  646. CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
  647. return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals),
  648. Wosize_val(ElementVals));
  649. }
  650. /*--... Constant expressions ...............................................--*/
  651. /* Icmp.t -> llvalue -> llvalue -> llvalue */
  652. CAMLprim LLVMValueRef llvm_const_icmp(value Pred,
  653. LLVMValueRef LHSConstant,
  654. LLVMValueRef RHSConstant) {
  655. return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant);
  656. }
  657. /* Fcmp.t -> llvalue -> llvalue -> llvalue */
  658. CAMLprim LLVMValueRef llvm_const_fcmp(value Pred,
  659. LLVMValueRef LHSConstant,
  660. LLVMValueRef RHSConstant) {
  661. return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant);
  662. }
  663. /* llvalue -> llvalue array -> llvalue */
  664. CAMLprim LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) {
  665. return LLVMConstGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
  666. Wosize_val(Indices));
  667. }
  668. /* llvalue -> llvalue array -> llvalue */
  669. CAMLprim LLVMValueRef llvm_const_in_bounds_gep(LLVMValueRef ConstantVal,
  670. value Indices) {
  671. return LLVMConstInBoundsGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
  672. Wosize_val(Indices));
  673. }
  674. /* llvalue -> lltype -> is_signed:bool -> llvalue */
  675. CAMLprim LLVMValueRef llvm_const_intcast(LLVMValueRef CV, LLVMTypeRef T,
  676. value IsSigned) {
  677. return LLVMConstIntCast(CV, T, Bool_val(IsSigned));
  678. }
  679. /* llvalue -> int array -> llvalue */
  680. CAMLprim LLVMValueRef llvm_const_extractvalue(LLVMValueRef Aggregate,
  681. value Indices) {
  682. CAMLparam1(Indices);
  683. int size = Wosize_val(Indices);
  684. int i;
  685. LLVMValueRef result;
  686. unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
  687. for (i = 0; i < size; i++) {
  688. idxs[i] = Int_val(Field(Indices, i));
  689. }
  690. result = LLVMConstExtractValue(Aggregate, idxs, size);
  691. free(idxs);
  692. CAMLreturnT(LLVMValueRef, result);
  693. }
  694. /* llvalue -> llvalue -> int array -> llvalue */
  695. CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate,
  696. LLVMValueRef Val, value Indices) {
  697. CAMLparam1(Indices);
  698. int size = Wosize_val(Indices);
  699. int i;
  700. LLVMValueRef result;
  701. unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
  702. for (i = 0; i < size; i++) {
  703. idxs[i] = Int_val(Field(Indices, i));
  704. }
  705. result = LLVMConstInsertValue(Aggregate, Val, idxs, size);
  706. free(idxs);
  707. CAMLreturnT(LLVMValueRef, result);
  708. }
  709. /* lltype -> string -> string -> bool -> bool -> llvalue */
  710. CAMLprim LLVMValueRef llvm_const_inline_asm(LLVMTypeRef Ty, value Asm,
  711. value Constraints, value HasSideEffects,
  712. value IsAlignStack) {
  713. return LLVMConstInlineAsm(Ty, String_val(Asm), String_val(Constraints),
  714. Bool_val(HasSideEffects), Bool_val(IsAlignStack));
  715. }
  716. /*--... Operations on global variables, functions, and aliases (globals) ...--*/
  717. /* llvalue -> bool */
  718. CAMLprim value llvm_is_declaration(LLVMValueRef Global) {
  719. return Val_bool(LLVMIsDeclaration(Global));
  720. }
  721. /* llvalue -> Linkage.t */
  722. CAMLprim value llvm_linkage(LLVMValueRef Global) {
  723. return Val_int(LLVMGetLinkage(Global));
  724. }
  725. /* Linkage.t -> llvalue -> unit */
  726. CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) {
  727. LLVMSetLinkage(Global, Int_val(Linkage));
  728. return Val_unit;
  729. }
  730. /* llvalue -> string */
  731. CAMLprim value llvm_section(LLVMValueRef Global) {
  732. return copy_string(LLVMGetSection(Global));
  733. }
  734. /* string -> llvalue -> unit */
  735. CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) {
  736. LLVMSetSection(Global, String_val(Section));
  737. return Val_unit;
  738. }
  739. /* llvalue -> Visibility.t */
  740. CAMLprim value llvm_visibility(LLVMValueRef Global) {
  741. return Val_int(LLVMGetVisibility(Global));
  742. }
  743. /* Visibility.t -> llvalue -> unit */
  744. CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) {
  745. LLVMSetVisibility(Global, Int_val(Viz));
  746. return Val_unit;
  747. }
  748. /* llvalue -> int */
  749. CAMLprim value llvm_alignment(LLVMValueRef Global) {
  750. return Val_int(LLVMGetAlignment(Global));
  751. }
  752. /* int -> llvalue -> unit */
  753. CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
  754. LLVMSetAlignment(Global, Int_val(Bytes));
  755. return Val_unit;
  756. }
  757. /*--... Operations on uses .................................................--*/
  758. /* llvalue -> lluse option */
  759. CAMLprim value llvm_use_begin(LLVMValueRef Val) {
  760. CAMLparam0();
  761. LLVMUseRef First;
  762. if ((First = LLVMGetFirstUse(Val))) {
  763. value Option = alloc(1, 0);
  764. Field(Option, 0) = (value) First;
  765. CAMLreturn(Option);
  766. }
  767. CAMLreturn(Val_int(0));
  768. }
  769. /* lluse -> lluse option */
  770. CAMLprim value llvm_use_succ(LLVMUseRef U) {
  771. CAMLparam0();
  772. LLVMUseRef Next;
  773. if ((Next = LLVMGetNextUse(U))) {
  774. value Option = alloc(1, 0);
  775. Field(Option, 0) = (value) Next;
  776. CAMLreturn(Option);
  777. }
  778. CAMLreturn(Val_int(0));
  779. }
  780. /* lluse -> llvalue */
  781. CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) {
  782. return LLVMGetUser(UR);
  783. }
  784. /* lluse -> llvalue */
  785. CAMLprim LLVMValueRef llvm_used_value(LLVMUseRef UR) {
  786. return LLVMGetUsedValue(UR);
  787. }
  788. /*--... Operations on global variables .....................................--*/
  789. DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef,
  790. LLVMGetGlobalParent)
  791. /* lltype -> string -> llmodule -> llvalue */
  792. CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
  793. LLVMModuleRef M) {
  794. LLVMValueRef GlobalVar;
  795. if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
  796. if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
  797. return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty, 0));
  798. return GlobalVar;
  799. }
  800. return LLVMAddGlobal(M, Ty, String_val(Name));
  801. }
  802. /* lltype -> string -> int -> llmodule -> llvalue */
  803. CAMLprim LLVMValueRef llvm_declare_qualified_global(LLVMTypeRef Ty, value Name,
  804. value AddressSpace,
  805. LLVMModuleRef M) {
  806. LLVMValueRef GlobalVar;
  807. if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
  808. if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
  809. return LLVMConstBitCast(GlobalVar,
  810. LLVMPointerType(Ty, Int_val(AddressSpace)));
  811. return GlobalVar;
  812. }
  813. return LLVMAddGlobalInAddressSpace(M, Ty, String_val(Name),
  814. Int_val(AddressSpace));
  815. }
  816. /* string -> llmodule -> llvalue option */
  817. CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
  818. CAMLparam1(Name);
  819. LLVMValueRef GlobalVar;
  820. if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
  821. value Option = alloc(1, 0);
  822. Field(Option, 0) = (value) GlobalVar;
  823. CAMLreturn(Option);
  824. }
  825. CAMLreturn(Val_int(0));
  826. }
  827. /* string -> llvalue -> llmodule -> llvalue */
  828. CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
  829. LLVMModuleRef M) {
  830. LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer),
  831. String_val(Name));
  832. LLVMSetInitializer(GlobalVar, Initializer);
  833. return GlobalVar;
  834. }
  835. /* string -> llvalue -> int -> llmodule -> llvalue */
  836. CAMLprim LLVMValueRef llvm_define_qualified_global(value Name,
  837. LLVMValueRef Initializer,
  838. value AddressSpace,
  839. LLVMModuleRef M) {
  840. LLVMValueRef GlobalVar = LLVMAddGlobalInAddressSpace(M,
  841. LLVMTypeOf(Initializer),
  842. String_val(Name),
  843. Int_val(AddressSpace));
  844. LLVMSetInitializer(GlobalVar, Initializer);
  845. return GlobalVar;
  846. }
  847. /* llvalue -> unit */
  848. CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) {
  849. LLVMDeleteGlobal(GlobalVar);
  850. return Val_unit;
  851. }
  852. /* llvalue -> llvalue -> unit */
  853. CAMLprim value llvm_set_initializer(LLVMValueRef ConstantVal,
  854. LLVMValueRef GlobalVar) {
  855. LLVMSetInitializer(GlobalVar, ConstantVal);
  856. return Val_unit;
  857. }
  858. /* llvalue -> unit */
  859. CAMLprim value llvm_remove_initializer(LLVMValueRef GlobalVar) {
  860. LLVMSetInitializer(GlobalVar, NULL);
  861. return Val_unit;
  862. }
  863. /* llvalue -> bool */
  864. CAMLprim value llvm_is_thread_local(LLVMValueRef GlobalVar) {
  865. return Val_bool(LLVMIsThreadLocal(GlobalVar));
  866. }
  867. /* bool -> llvalue -> unit */
  868. CAMLprim value llvm_set_thread_local(value IsThreadLocal,
  869. LLVMValueRef GlobalVar) {
  870. LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal));
  871. return Val_unit;
  872. }
  873. /* llvalue -> ThreadLocalMode.t */
  874. CAMLprim value llvm_thread_local_mode(LLVMValueRef GlobalVar) {
  875. return Val_int(LLVMGetThreadLocalMode(GlobalVar));
  876. }
  877. /* ThreadLocalMode.t -> llvalue -> unit */
  878. CAMLprim value llvm_set_thread_local_mode(value ThreadLocalMode,
  879. LLVMValueRef GlobalVar) {
  880. LLVMSetThreadLocalMode(GlobalVar, Int_val(ThreadLocalMode));
  881. return Val_unit;
  882. }
  883. /* llvalue -> bool */
  884. CAMLprim value llvm_is_externally_initialized(LLVMValueRef GlobalVar) {
  885. return Val_bool(LLVMIsExternallyInitialized(GlobalVar));
  886. }
  887. /* bool -> llvalue -> unit */
  888. CAMLprim value llvm_set_externally_initialized(value IsExternallyInitialized,
  889. LLVMValueRef GlobalVar) {
  890. LLVMSetExternallyInitialized(GlobalVar, Bool_val(IsExternallyInitialized));
  891. return Val_unit;
  892. }
  893. /* llvalue -> bool */
  894. CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) {
  895. return Val_bool(LLVMIsGlobalConstant(GlobalVar));
  896. }
  897. /* bool -> llvalue -> unit */
  898. CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
  899. LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag));
  900. return Val_unit;
  901. }
  902. /*--... Operations on aliases ..............................................--*/
  903. CAMLprim LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty,
  904. LLVMValueRef Aliasee, value Name) {
  905. return LLVMAddAlias(M, Ty, Aliasee, String_val(Name));
  906. }
  907. /*--... Operations on functions ............................................--*/
  908. DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef,
  909. LLVMGetGlobalParent)
  910. /* string -> lltype -> llmodule -> llvalue */
  911. CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
  912. LLVMModuleRef M) {
  913. LLVMValueRef Fn;
  914. if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
  915. if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
  916. return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0));
  917. return Fn;
  918. }
  919. return LLVMAddFunction(M, String_val(Name), Ty);
  920. }
  921. /* string -> llmodule -> llvalue option */
  922. CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
  923. CAMLparam1(Name);
  924. LLVMValueRef Fn;
  925. if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
  926. value Option = alloc(1, 0);
  927. Field(Option, 0) = (value) Fn;
  928. CAMLreturn(Option);
  929. }
  930. CAMLreturn(Val_int(0));
  931. }
  932. /* string -> lltype -> llmodule -> llvalue */
  933. CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
  934. LLVMModuleRef M) {
  935. LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
  936. LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry");
  937. return Fn;
  938. }
  939. /* llvalue -> unit */
  940. CAMLprim value llvm_delete_function(LLVMValueRef Fn) {
  941. LLVMDeleteFunction(Fn);
  942. return Val_unit;
  943. }
  944. /* llvalue -> bool */
  945. CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) {
  946. return Val_bool(LLVMGetIntrinsicID(Fn));
  947. }
  948. /* llvalue -> int */
  949. CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) {
  950. return Val_int(LLVMGetFunctionCallConv(Fn));
  951. }
  952. /* int -> llvalue -> unit */
  953. CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) {
  954. LLVMSetFunctionCallConv(Fn, Int_val(Id));
  955. return Val_unit;
  956. }
  957. /* llvalue -> string option */
  958. CAMLprim value llvm_gc(LLVMValueRef Fn) {
  959. const char *GC;
  960. CAMLparam0();
  961. CAMLlocal2(Name, Option);
  962. if ((GC = LLVMGetGC(Fn))) {
  963. Name = copy_string(GC);
  964. Option = alloc(1, 0);
  965. Field(Option, 0) = Name;
  966. CAMLreturn(Option);
  967. } else {
  968. CAMLreturn(Val_int(0));
  969. }
  970. }
  971. /* string option -> llvalue -> unit */
  972. CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
  973. LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0)));
  974. return Val_unit;
  975. }
  976. /* llvalue -> int32 -> unit */
  977. CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
  978. LLVMAddFunctionAttr(Arg, Int32_val(PA));
  979. return Val_unit;
  980. }
  981. /* llvalue -> string -> string -> unit */
  982. CAMLprim value llvm_add_target_dependent_function_attr(
  983. LLVMValueRef Arg, value A, value V) {
  984. LLVMAddTargetDependentFunctionAttr(Arg, String_val(A), String_val(V));
  985. return Val_unit;
  986. }
  987. /* llvalue -> int32 */
  988. CAMLprim value llvm_function_attr(LLVMValueRef Fn)
  989. {
  990. CAMLparam0();
  991. CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
  992. }
  993. /* llvalue -> int32 -> unit */
  994. CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
  995. LLVMRemoveFunctionAttr(Arg, Int32_val(PA));
  996. return Val_unit;
  997. }
  998. /*--... Operations on parameters ...........................................--*/
  999. DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
  1000. /* llvalue -> int -> llvalue */
  1001. CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
  1002. return LLVMGetParam(Fn, Int_val(Index));
  1003. }
  1004. /* llvalue -> int */
  1005. CAMLprim value llvm_param_attr(LLVMValueRef Param)
  1006. {
  1007. CAMLparam0();
  1008. CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
  1009. }
  1010. /* llvalue -> llvalue */
  1011. CAMLprim value llvm_params(LLVMValueRef Fn) {
  1012. value Params = alloc(LLVMCountParams(Fn), 0);
  1013. LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
  1014. return Params;
  1015. }
  1016. /* llvalue -> int32 -> unit */
  1017. CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
  1018. LLVMAddAttribute(Arg, Int32_val(PA));
  1019. return Val_unit;
  1020. }
  1021. /* llvalue -> int32 -> unit */
  1022. CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
  1023. LLVMRemoveAttribute(Arg, Int32_val(PA));
  1024. return Val_unit;
  1025. }
  1026. /* llvalue -> int -> unit */
  1027. CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
  1028. LLVMSetParamAlignment(Arg, Int_val(align));
  1029. return Val_unit;
  1030. }
  1031. /*--... Operations on basic blocks .........................................--*/
  1032. DEFINE_ITERATORS(
  1033. block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
  1034. /* llbasicblock -> llvalue option */
  1035. CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
  1036. {
  1037. CAMLparam0();
  1038. LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
  1039. if (Term) {
  1040. value Option = alloc(1, 0);
  1041. Field(Option, 0) = (value) Term;
  1042. CAMLreturn(Option);
  1043. }
  1044. CAMLreturn(Val_int(0));
  1045. }
  1046. /* llvalue -> llbasicblock array */
  1047. CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
  1048. value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
  1049. LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
  1050. return MLArray;
  1051. }
  1052. /* llbasicblock -> unit */
  1053. CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
  1054. LLVMDeleteBasicBlock(BB);
  1055. return Val_unit;
  1056. }
  1057. /* llbasicblock -> unit */
  1058. CAMLprim value llvm_remove_block(LLVMBasicBlockRef BB) {
  1059. LLVMRemoveBasicBlockFromParent(BB);
  1060. return Val_unit;
  1061. }
  1062. /* llbasicblock -> llbasicblock -> unit */
  1063. CAMLprim value llvm_move_block_before(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
  1064. LLVMMoveBasicBlockBefore(BB, Pos);
  1065. return Val_unit;
  1066. }
  1067. /* llbasicblock -> llbasicblock -> unit */
  1068. CAMLprim value llvm_move_block_after(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
  1069. LLVMMoveBasicBlockAfter(BB, Pos);
  1070. return Val_unit;
  1071. }
  1072. /* string -> llvalue -> llbasicblock */
  1073. CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
  1074. LLVMValueRef Fn) {
  1075. return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name));
  1076. }
  1077. /* string -> llbasicblock -> llbasicblock */
  1078. CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name,
  1079. LLVMBasicBlockRef BB) {
  1080. return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name));
  1081. }
  1082. /* llvalue -> bool */
  1083. CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
  1084. return Val_bool(LLVMValueIsBasicBlock(Val));
  1085. }
  1086. /*--... Operations on instructions .........................................--*/
  1087. DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
  1088. LLVMGetInstructionParent)
  1089. /* llvalue -> Opcode.t */
  1090. CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
  1091. LLVMOpcode o;
  1092. if (!LLVMIsAInstruction(Inst))
  1093. failwith("Not an instruction");
  1094. o = LLVMGetInstructionOpcode(Inst);
  1095. assert (o <= LLVMLandingPad);
  1096. return Val_int(o);
  1097. }
  1098. /* llvalue -> ICmp.t option */
  1099. CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
  1100. CAMLparam0();
  1101. int x = LLVMGetICmpPredicate(Val);
  1102. if (x) {
  1103. value Option = alloc(1, 0);
  1104. Field(Option, 0) = Val_int(x - LLVMIntEQ);
  1105. CAMLreturn(Option);
  1106. }
  1107. CAMLreturn(Val_int(0));
  1108. }
  1109. /*--... Operations on call sites ...........................................--*/
  1110. /* llvalue -> int */
  1111. CAMLprim value llvm_instruction_call_conv(LLVMValueRef Inst) {
  1112. return Val_int(LLVMGetInstructionCallConv(Inst));
  1113. }
  1114. /* int -> llvalue -> unit */
  1115. CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
  1116. LLVMSetInstructionCallConv(Inst, Int_val(CC));
  1117. return Val_unit;
  1118. }
  1119. /* llvalue -> int -> int32 -> unit */
  1120. CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
  1121. value index,
  1122. value PA) {
  1123. LLVMAddInstrAttribute(Instr, Int_val(index), Int32_val(PA));
  1124. return Val_unit;
  1125. }
  1126. /* llvalue -> int -> int32 -> unit */
  1127. CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
  1128. value index,
  1129. value PA) {
  1130. LLVMRemoveInstrAttribute(Instr, Int_val(index), Int32_val(PA));
  1131. return Val_unit;
  1132. }
  1133. /*--... Operations on call instructions (only) .............................--*/
  1134. /* llvalue -> bool */
  1135. CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) {
  1136. return Val_bool(LLVMIsTailCall(CallInst));
  1137. }
  1138. /* bool -> llvalue -> unit */
  1139. CAMLprim value llvm_set_tail_call(value IsTailCall,
  1140. LLVMValueRef CallInst) {
  1141. LLVMSetTailCall(CallInst, Bool_val(IsTailCall));
  1142. return Val_unit;
  1143. }
  1144. /*--... Operations on load/store instructions (only)........................--*/
  1145. /* llvalue -> bool */
  1146. CAMLprim value llvm_is_volatile(LLVMValueRef MemoryInst) {
  1147. return Val_bool(LLVMGetVolatile(MemoryInst));
  1148. }
  1149. /* bool -> llvalue -> unit */
  1150. CAMLprim value llvm_set_volatile(value IsVolatile,
  1151. LLVMValueRef MemoryInst) {
  1152. LLVMSetVolatile(MemoryInst, Bool_val(IsVolatile));
  1153. return Val_unit;
  1154. }
  1155. /*--... Operations on phi nodes ............................................--*/
  1156. /* (llvalue * llbasicblock) -> llvalue -> unit */
  1157. CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
  1158. LLVMAddIncoming(PhiNode,
  1159. (LLVMValueRef*) &Field(Incoming, 0),
  1160. (LLVMBasicBlockRef*) &Field(Incoming, 1),
  1161. 1);
  1162. return Val_unit;
  1163. }
  1164. /* llvalue -> (llvalue * llbasicblock) list */
  1165. CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
  1166. unsigned I;
  1167. CAMLparam0();
  1168. CAMLlocal3(Hd, Tl, Tmp);
  1169. /* Build a tuple list of them. */
  1170. Tl = Val_int(0);
  1171. for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
  1172. Hd = alloc(2, 0);
  1173. Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
  1174. Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
  1175. Tmp = alloc(2, 0);
  1176. Store_field(Tmp, 0, Hd);
  1177. Store_field(Tmp, 1, Tl);
  1178. Tl = Tmp;
  1179. }
  1180. CAMLreturn(Tl);
  1181. }
  1182. /* llvalue -> unit */
  1183. CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
  1184. LLVMInstructionEraseFromParent(Instruction);
  1185. return Val_unit;
  1186. }
  1187. /*===-- Instruction builders ----------------------------------------------===*/
  1188. #define Builder_val(v) (*(LLVMBuilderRef *)(Data_custom_val(v)))
  1189. static void llvm_finalize_builder(value B) {
  1190. LLVMDisposeBuilder(Builder_val(B));
  1191. }
  1192. static struct custom_operations builder_ops = {
  1193. (char *) "LLVMIRBuilder",
  1194. llvm_finalize_builder,
  1195. custom_compare_default,
  1196. custom_hash_default,
  1197. custom_serialize_default,
  1198. custom_deserialize_default
  1199. #ifdef custom_compare_ext_default
  1200. , custom_compare_ext_default
  1201. #endif
  1202. };
  1203. static value alloc_builder(LLVMBuilderRef B) {
  1204. value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
  1205. Builder_val(V) = B;
  1206. return V;
  1207. }
  1208. /* llcontext -> llbuilder */
  1209. CAMLprim value llvm_builder(LLVMContextRef C) {
  1210. return alloc_builder(LLVMCreateBuilderInContext(C));
  1211. }
  1212. /* (llbasicblock, llvalue) llpos -> llbuilder -> unit */
  1213. CAMLprim value llvm_position_builder(value Pos, value B) {
  1214. if (Tag_val(Pos) == 0) {
  1215. LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0));
  1216. LLVMPositionBuilderAtEnd(Builder_val(B), BB);
  1217. } else {
  1218. LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0));
  1219. LLVMPositionBuilderBefore(Builder_val(B), I);
  1220. }
  1221. return Val_unit;
  1222. }
  1223. /* llbuilder -> llbasicblock */
  1224. CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) {
  1225. LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
  1226. if (!InsertBlock)
  1227. raise_not_found();
  1228. return InsertBlock;
  1229. }
  1230. /* llvalue -> string -> llbuilder -> unit */
  1231. CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) {
  1232. LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name));
  1233. return Val_unit;
  1234. }
  1235. /*--... Metadata ...........................................................--*/
  1236. /* llbuilder -> llvalue -> unit */
  1237. CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) {
  1238. LLVMSetCurrentDebugLocation(Builder_val(B), V);
  1239. return Val_unit;
  1240. }
  1241. /* llbuilder -> unit */
  1242. CAMLprim value llvm_clear_current_debug_location(value B) {
  1243. LLVMSetCurrentDebugLocation(Builder_val(B), NULL);
  1244. return Val_unit;
  1245. }
  1246. /* llbuilder -> llvalue option */
  1247. CAMLprim value llvm_current_debug_location(value B) {
  1248. CAMLparam0();
  1249. LLVMValueRef L;
  1250. if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) {
  1251. value Option = alloc(1, 0);
  1252. Field(Option, 0) = (value) L;
  1253. CAMLreturn(Option);
  1254. }
  1255. CAMLreturn(Val_int(0));
  1256. }
  1257. /* llbuilder -> llvalue -> unit */
  1258. CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) {
  1259. LLVMSetInstDebugLocation(Builder_val(B), V);
  1260. return Val_unit;
  1261. }
  1262. /*--... Terminators ........................................................--*/
  1263. /* llbuilder -> llvalue */
  1264. CAMLprim LLVMValueRef llvm_build_ret_void(value B) {
  1265. return LLVMBuildRetVoid(Builder_val(B));
  1266. }
  1267. /* llvalue -> llbuilder -> llvalue */
  1268. CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) {
  1269. return LLVMBuildRet(Builder_val(B), Val);
  1270. }
  1271. /* llvalue array -> llbuilder -> llvalue */
  1272. CAMLprim LLVMValueRef llvm_build_aggregate_ret(value RetVals, value B) {
  1273. return LLVMBuildAggregateRet(Builder_val(B), (LLVMValueRef *) Op_val(RetVals),
  1274. Wosize_val(RetVals));
  1275. }
  1276. /* llbasicblock -> llbuilder -> llvalue */
  1277. CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) {
  1278. return LLVMBuildBr(Builder_val(B), BB);
  1279. }
  1280. /* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */
  1281. CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If,
  1282. LLVMBasicBlockRef Then,
  1283. LLVMBasicBlockRef Else,
  1284. value B) {
  1285. return LLVMBuildCondBr(Builder_val(B), If, Then, Else);
  1286. }
  1287. /* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */
  1288. CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
  1289. LLVMBasicBlockRef Else,
  1290. value EstimatedCount,
  1291. value B) {
  1292. return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
  1293. }
  1294. /* lltype -> string -> llbuilder -> llvalue */
  1295. CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
  1296. value B)
  1297. {
  1298. return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
  1299. }
  1300. /* lltype -> llvalue -> string -> llbuilder -> llvalue */
  1301. CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
  1302. LLVMValueRef Val,
  1303. value Name, value B)
  1304. {
  1305. return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
  1306. }
  1307. /* llvalue -> llbuilder -> llvalue */
  1308. CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
  1309. {
  1310. return LLVMBuildFree(Builder_val(B), P);
  1311. }
  1312. /* llvalue -> llvalue -> llbasicblock -> unit */
  1313. CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
  1314. LLVMBasicBlockRef Dest) {
  1315. LLVMAddCase(Switch, OnVal, Dest);
  1316. return Val_unit;
  1317. }
  1318. /* llvalue -> llbasicblock -> llbuilder -> llvalue */
  1319. CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr,
  1320. value