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
18 #include <assert.h>
19 #include <stdlib.h>
20 #include <string.h>
21 #include "llvm-c/Core.h"
22 #include "caml/alloc.h"
23 #include "caml/custom.h"
24 #include "caml/memory.h"
25 #include "caml/fail.h"
26 #include "caml/callback.h"
27
llvm_string_of_message(char * Message)28 value llvm_string_of_message(char* Message) {
29 value String = caml_copy_string(Message);
30 LLVMDisposeMessage(Message);
31
32 return String;
33 }
34
llvm_raise(value Prototype,char * Message)35 void llvm_raise(value Prototype, char *Message) {
36 CAMLparam1(Prototype);
37 caml_raise_with_arg(Prototype, llvm_string_of_message(Message));
38 CAMLnoreturn;
39 }
40
41 static value llvm_fatal_error_handler;
42
llvm_fatal_error_trampoline(const char * Reason)43 static void llvm_fatal_error_trampoline(const char *Reason) {
44 callback(llvm_fatal_error_handler, caml_copy_string(Reason));
45 }
46
llvm_install_fatal_error_handler(value Handler)47 CAMLprim value llvm_install_fatal_error_handler(value Handler) {
48 LLVMInstallFatalErrorHandler(llvm_fatal_error_trampoline);
49 llvm_fatal_error_handler = Handler;
50 caml_register_global_root(&llvm_fatal_error_handler);
51 return Val_unit;
52 }
53
llvm_reset_fatal_error_handler(value Unit)54 CAMLprim value llvm_reset_fatal_error_handler(value Unit) {
55 caml_remove_global_root(&llvm_fatal_error_handler);
56 LLVMResetFatalErrorHandler();
57 return Val_unit;
58 }
59
llvm_enable_pretty_stacktrace(value Unit)60 CAMLprim value llvm_enable_pretty_stacktrace(value Unit) {
61 LLVMEnablePrettyStackTrace();
62 return Val_unit;
63 }
64
llvm_parse_command_line_options(value Overview,value Args)65 CAMLprim value llvm_parse_command_line_options(value Overview, value Args) {
66 char *COverview;
67 if (Overview == Val_int(0)) {
68 COverview = NULL;
69 } else {
70 COverview = String_val(Field(Overview, 0));
71 }
72 LLVMParseCommandLineOptions(Wosize_val(Args), (const char* const*) Op_val(Args), COverview);
73 return Val_unit;
74 }
75
alloc_variant(int tag,void * Value)76 static value alloc_variant(int tag, void *Value) {
77 value Iter = alloc_small(1, tag);
78 Field(Iter, 0) = Val_op(Value);
79 return Iter;
80 }
81
82 /* Macro to convert the C first/next/last/prev idiom to the Ocaml llpos/
83 llrev_pos idiom. */
84 #define DEFINE_ITERATORS(camlname, cname, pty, cty, pfun) \
85 /* llmodule -> ('a, 'b) llpos */ \
86 CAMLprim value llvm_##camlname##_begin(pty Mom) { \
87 cty First = LLVMGetFirst##cname(Mom); \
88 if (First) \
89 return alloc_variant(1, First); \
90 return alloc_variant(0, Mom); \
91 } \
92 \
93 /* llvalue -> ('a, 'b) llpos */ \
94 CAMLprim value llvm_##camlname##_succ(cty Kid) { \
95 cty Next = LLVMGetNext##cname(Kid); \
96 if (Next) \
97 return alloc_variant(1, Next); \
98 return alloc_variant(0, pfun(Kid)); \
99 } \
100 \
101 /* llmodule -> ('a, 'b) llrev_pos */ \
102 CAMLprim value llvm_##camlname##_end(pty Mom) { \
103 cty Last = LLVMGetLast##cname(Mom); \
104 if (Last) \
105 return alloc_variant(1, Last); \
106 return alloc_variant(0, Mom); \
107 } \
108 \
109 /* llvalue -> ('a, 'b) llrev_pos */ \
110 CAMLprim value llvm_##camlname##_pred(cty Kid) { \
111 cty Prev = LLVMGetPrevious##cname(Kid); \
112 if (Prev) \
113 return alloc_variant(1, Prev); \
114 return alloc_variant(0, pfun(Kid)); \
115 }
116
117
118 /*===-- Contexts ----------------------------------------------------------===*/
119
120 /* unit -> llcontext */
llvm_create_context(value Unit)121 CAMLprim LLVMContextRef llvm_create_context(value Unit) {
122 return LLVMContextCreate();
123 }
124
125 /* llcontext -> unit */
llvm_dispose_context(LLVMContextRef C)126 CAMLprim value llvm_dispose_context(LLVMContextRef C) {
127 LLVMContextDispose(C);
128 return Val_unit;
129 }
130
131 /* unit -> llcontext */
llvm_global_context(value Unit)132 CAMLprim LLVMContextRef llvm_global_context(value Unit) {
133 return LLVMGetGlobalContext();
134 }
135
136 /* llcontext -> string -> int */
llvm_mdkind_id(LLVMContextRef C,value Name)137 CAMLprim value llvm_mdkind_id(LLVMContextRef C, value Name) {
138 unsigned MDKindID = LLVMGetMDKindIDInContext(C, String_val(Name),
139 caml_string_length(Name));
140 return Val_int(MDKindID);
141 }
142
143 /*===-- Modules -----------------------------------------------------------===*/
144
145 /* llcontext -> string -> llmodule */
llvm_create_module(LLVMContextRef C,value ModuleID)146 CAMLprim LLVMModuleRef llvm_create_module(LLVMContextRef C, value ModuleID) {
147 return LLVMModuleCreateWithNameInContext(String_val(ModuleID), C);
148 }
149
150 /* llmodule -> unit */
llvm_dispose_module(LLVMModuleRef M)151 CAMLprim value llvm_dispose_module(LLVMModuleRef M) {
152 LLVMDisposeModule(M);
153 return Val_unit;
154 }
155
156 /* llmodule -> string */
llvm_target_triple(LLVMModuleRef M)157 CAMLprim value llvm_target_triple(LLVMModuleRef M) {
158 return caml_copy_string(LLVMGetTarget(M));
159 }
160
161 /* string -> llmodule -> unit */
llvm_set_target_triple(value Trip,LLVMModuleRef M)162 CAMLprim value llvm_set_target_triple(value Trip, LLVMModuleRef M) {
163 LLVMSetTarget(M, String_val(Trip));
164 return Val_unit;
165 }
166
167 /* llmodule -> string */
llvm_data_layout(LLVMModuleRef M)168 CAMLprim value llvm_data_layout(LLVMModuleRef M) {
169 return caml_copy_string(LLVMGetDataLayout(M));
170 }
171
172 /* string -> llmodule -> unit */
llvm_set_data_layout(value Layout,LLVMModuleRef M)173 CAMLprim value llvm_set_data_layout(value Layout, LLVMModuleRef M) {
174 LLVMSetDataLayout(M, String_val(Layout));
175 return Val_unit;
176 }
177
178 /* llmodule -> unit */
llvm_dump_module(LLVMModuleRef M)179 CAMLprim value llvm_dump_module(LLVMModuleRef M) {
180 LLVMDumpModule(M);
181 return Val_unit;
182 }
183
184 /* string -> llmodule -> unit */
llvm_print_module(value Filename,LLVMModuleRef M)185 CAMLprim value llvm_print_module(value Filename, LLVMModuleRef M) {
186 char* Message;
187
188 if(LLVMPrintModuleToFile(M, String_val(Filename), &Message))
189 llvm_raise(*caml_named_value("Llvm.IoError"), Message);
190
191 return Val_unit;
192 }
193
194 /* llmodule -> string */
llvm_string_of_llmodule(LLVMModuleRef M)195 CAMLprim value llvm_string_of_llmodule(LLVMModuleRef M) {
196 CAMLparam0();
197 CAMLlocal1(ModuleStr);
198 char* ModuleCStr;
199
200 ModuleCStr = LLVMPrintModuleToString(M);
201 ModuleStr = caml_copy_string(ModuleCStr);
202 LLVMDisposeMessage(ModuleCStr);
203
204 CAMLreturn(ModuleStr);
205 }
206
207 /* llmodule -> string -> unit */
llvm_set_module_inline_asm(LLVMModuleRef M,value Asm)208 CAMLprim value llvm_set_module_inline_asm(LLVMModuleRef M, value Asm) {
209 LLVMSetModuleInlineAsm(M, String_val(Asm));
210 return Val_unit;
211 }
212
213 /*===-- Types -------------------------------------------------------------===*/
214
215 /* lltype -> TypeKind.t */
llvm_classify_type(LLVMTypeRef Ty)216 CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
217 return Val_int(LLVMGetTypeKind(Ty));
218 }
219
llvm_type_is_sized(LLVMTypeRef Ty)220 CAMLprim value llvm_type_is_sized(LLVMTypeRef Ty) {
221 return Val_bool(LLVMTypeIsSized(Ty));
222 }
223
224 /* lltype -> llcontext */
llvm_type_context(LLVMTypeRef Ty)225 CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) {
226 return LLVMGetTypeContext(Ty);
227 }
228
229 /* lltype -> unit */
llvm_dump_type(LLVMTypeRef Val)230 CAMLprim value llvm_dump_type(LLVMTypeRef Val) {
231 LLVMDumpType(Val);
232 return Val_unit;
233 }
234
235 /* lltype -> string */
llvm_string_of_lltype(LLVMTypeRef M)236 CAMLprim value llvm_string_of_lltype(LLVMTypeRef M) {
237 CAMLparam0();
238 CAMLlocal1(TypeStr);
239 char* TypeCStr;
240
241 TypeCStr = LLVMPrintTypeToString(M);
242 TypeStr = caml_copy_string(TypeCStr);
243 LLVMDisposeMessage(TypeCStr);
244
245 CAMLreturn(TypeStr);
246 }
247
248 /*--... Operations on integer types ........................................--*/
249
250 /* llcontext -> lltype */
llvm_i1_type(LLVMContextRef Context)251 CAMLprim LLVMTypeRef llvm_i1_type (LLVMContextRef Context) {
252 return LLVMInt1TypeInContext(Context);
253 }
254
255 /* llcontext -> lltype */
llvm_i8_type(LLVMContextRef Context)256 CAMLprim LLVMTypeRef llvm_i8_type (LLVMContextRef Context) {
257 return LLVMInt8TypeInContext(Context);
258 }
259
260 /* llcontext -> lltype */
llvm_i16_type(LLVMContextRef Context)261 CAMLprim LLVMTypeRef llvm_i16_type (LLVMContextRef Context) {
262 return LLVMInt16TypeInContext(Context);
263 }
264
265 /* llcontext -> lltype */
llvm_i32_type(LLVMContextRef Context)266 CAMLprim LLVMTypeRef llvm_i32_type (LLVMContextRef Context) {
267 return LLVMInt32TypeInContext(Context);
268 }
269
270 /* llcontext -> lltype */
llvm_i64_type(LLVMContextRef Context)271 CAMLprim LLVMTypeRef llvm_i64_type (LLVMContextRef Context) {
272 return LLVMInt64TypeInContext(Context);
273 }
274
275 /* llcontext -> int -> lltype */
llvm_integer_type(LLVMContextRef Context,value Width)276 CAMLprim LLVMTypeRef llvm_integer_type(LLVMContextRef Context, value Width) {
277 return LLVMIntTypeInContext(Context, Int_val(Width));
278 }
279
280 /* lltype -> int */
llvm_integer_bitwidth(LLVMTypeRef IntegerTy)281 CAMLprim value llvm_integer_bitwidth(LLVMTypeRef IntegerTy) {
282 return Val_int(LLVMGetIntTypeWidth(IntegerTy));
283 }
284
285 /*--... Operations on real types ...........................................--*/
286
287 /* llcontext -> lltype */
llvm_float_type(LLVMContextRef Context)288 CAMLprim LLVMTypeRef llvm_float_type(LLVMContextRef Context) {
289 return LLVMFloatTypeInContext(Context);
290 }
291
292 /* llcontext -> lltype */
llvm_double_type(LLVMContextRef Context)293 CAMLprim LLVMTypeRef llvm_double_type(LLVMContextRef Context) {
294 return LLVMDoubleTypeInContext(Context);
295 }
296
297 /* llcontext -> lltype */
llvm_x86fp80_type(LLVMContextRef Context)298 CAMLprim LLVMTypeRef llvm_x86fp80_type(LLVMContextRef Context) {
299 return LLVMX86FP80TypeInContext(Context);
300 }
301
302 /* llcontext -> lltype */
llvm_fp128_type(LLVMContextRef Context)303 CAMLprim LLVMTypeRef llvm_fp128_type(LLVMContextRef Context) {
304 return LLVMFP128TypeInContext(Context);
305 }
306
307 /* llcontext -> lltype */
llvm_ppc_fp128_type(LLVMContextRef Context)308 CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) {
309 return LLVMPPCFP128TypeInContext(Context);
310 }
311
312 /*--... Operations on function types .......................................--*/
313
314 /* lltype -> lltype array -> lltype */
llvm_function_type(LLVMTypeRef RetTy,value ParamTys)315 CAMLprim LLVMTypeRef llvm_function_type(LLVMTypeRef RetTy, value ParamTys) {
316 return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
317 Wosize_val(ParamTys), 0);
318 }
319
320 /* lltype -> lltype array -> lltype */
llvm_var_arg_function_type(LLVMTypeRef RetTy,value ParamTys)321 CAMLprim LLVMTypeRef llvm_var_arg_function_type(LLVMTypeRef RetTy,
322 value ParamTys) {
323 return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
324 Wosize_val(ParamTys), 1);
325 }
326
327 /* lltype -> bool */
llvm_is_var_arg(LLVMTypeRef FunTy)328 CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) {
329 return Val_bool(LLVMIsFunctionVarArg(FunTy));
330 }
331
332 /* lltype -> lltype array */
llvm_param_types(LLVMTypeRef FunTy)333 CAMLprim value llvm_param_types(LLVMTypeRef FunTy) {
334 value Tys = alloc(LLVMCountParamTypes(FunTy), 0);
335 LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys);
336 return Tys;
337 }
338
339 /*--... Operations on struct types .........................................--*/
340
341 /* llcontext -> lltype array -> lltype */
llvm_struct_type(LLVMContextRef C,value ElementTypes)342 CAMLprim LLVMTypeRef llvm_struct_type(LLVMContextRef C, value ElementTypes) {
343 return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
344 Wosize_val(ElementTypes), 0);
345 }
346
347 /* llcontext -> lltype array -> lltype */
llvm_packed_struct_type(LLVMContextRef C,value ElementTypes)348 CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C,
349 value ElementTypes) {
350 return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
351 Wosize_val(ElementTypes), 1);
352 }
353
354 /* llcontext -> string -> lltype */
llvm_named_struct_type(LLVMContextRef C,value Name)355 CAMLprim LLVMTypeRef llvm_named_struct_type(LLVMContextRef C,
356 value Name) {
357 return LLVMStructCreateNamed(C, String_val(Name));
358 }
359
llvm_struct_set_body(LLVMTypeRef Ty,value ElementTypes,value Packed)360 CAMLprim value llvm_struct_set_body(LLVMTypeRef Ty,
361 value ElementTypes,
362 value Packed) {
363 LLVMStructSetBody(Ty, (LLVMTypeRef *) ElementTypes,
364 Wosize_val(ElementTypes), Bool_val(Packed));
365 return Val_unit;
366 }
367
368 /* lltype -> string option */
llvm_struct_name(LLVMTypeRef Ty)369 CAMLprim value llvm_struct_name(LLVMTypeRef Ty)
370 {
371 CAMLparam0();
372 const char *C = LLVMGetStructName(Ty);
373 if (C) {
374 CAMLlocal1(result);
375 result = caml_alloc_small(1, 0);
376 Store_field(result, 0, caml_copy_string(C));
377 CAMLreturn(result);
378 }
379 CAMLreturn(Val_int(0));
380 }
381
382 /* lltype -> lltype array */
llvm_struct_element_types(LLVMTypeRef StructTy)383 CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) {
384 value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
385 LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys);
386 return Tys;
387 }
388
389 /* lltype -> bool */
llvm_is_packed(LLVMTypeRef StructTy)390 CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) {
391 return Val_bool(LLVMIsPackedStruct(StructTy));
392 }
393
394 /* lltype -> bool */
llvm_is_opaque(LLVMTypeRef StructTy)395 CAMLprim value llvm_is_opaque(LLVMTypeRef StructTy) {
396 return Val_bool(LLVMIsOpaqueStruct(StructTy));
397 }
398
399 /*--... Operations on array, pointer, and vector types .....................--*/
400
401 /* lltype -> int -> lltype */
llvm_array_type(LLVMTypeRef ElementTy,value Count)402 CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) {
403 return LLVMArrayType(ElementTy, Int_val(Count));
404 }
405
406 /* lltype -> lltype */
llvm_pointer_type(LLVMTypeRef ElementTy)407 CAMLprim LLVMTypeRef llvm_pointer_type(LLVMTypeRef ElementTy) {
408 return LLVMPointerType(ElementTy, 0);
409 }
410
411 /* lltype -> int -> lltype */
llvm_qualified_pointer_type(LLVMTypeRef ElementTy,value AddressSpace)412 CAMLprim LLVMTypeRef llvm_qualified_pointer_type(LLVMTypeRef ElementTy,
413 value AddressSpace) {
414 return LLVMPointerType(ElementTy, Int_val(AddressSpace));
415 }
416
417 /* lltype -> int -> lltype */
llvm_vector_type(LLVMTypeRef ElementTy,value Count)418 CAMLprim LLVMTypeRef llvm_vector_type(LLVMTypeRef ElementTy, value Count) {
419 return LLVMVectorType(ElementTy, Int_val(Count));
420 }
421
422 /* lltype -> int */
llvm_array_length(LLVMTypeRef ArrayTy)423 CAMLprim value llvm_array_length(LLVMTypeRef ArrayTy) {
424 return Val_int(LLVMGetArrayLength(ArrayTy));
425 }
426
427 /* lltype -> int */
llvm_address_space(LLVMTypeRef PtrTy)428 CAMLprim value llvm_address_space(LLVMTypeRef PtrTy) {
429 return Val_int(LLVMGetPointerAddressSpace(PtrTy));
430 }
431
432 /* lltype -> int */
llvm_vector_size(LLVMTypeRef VectorTy)433 CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) {
434 return Val_int(LLVMGetVectorSize(VectorTy));
435 }
436
437 /*--... Operations on other types ..........................................--*/
438
439 /* llcontext -> lltype */
llvm_void_type(LLVMContextRef Context)440 CAMLprim LLVMTypeRef llvm_void_type (LLVMContextRef Context) {
441 return LLVMVoidTypeInContext(Context);
442 }
443
444 /* llcontext -> lltype */
llvm_label_type(LLVMContextRef Context)445 CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
446 return LLVMLabelTypeInContext(Context);
447 }
448
449 /* llcontext -> lltype */
llvm_x86_mmx_type(LLVMContextRef Context)450 CAMLprim LLVMTypeRef llvm_x86_mmx_type(LLVMContextRef Context) {
451 return LLVMX86MMXTypeInContext(Context);
452 }
453
llvm_type_by_name(LLVMModuleRef M,value Name)454 CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
455 {
456 CAMLparam1(Name);
457 LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
458 if (Ty) {
459 value Option = alloc(1, 0);
460 Field(Option, 0) = (value) Ty;
461 CAMLreturn(Option);
462 }
463 CAMLreturn(Val_int(0));
464 }
465
466 /*===-- VALUES ------------------------------------------------------------===*/
467
468 /* llvalue -> lltype */
llvm_type_of(LLVMValueRef Val)469 CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) {
470 return LLVMTypeOf(Val);
471 }
472
473 /* keep in sync with ValueKind.t */
474 enum ValueKind {
475 NullValue=0,
476 Argument,
477 BasicBlock,
478 InlineAsm,
479 MDNode,
480 MDString,
481 BlockAddress,
482 ConstantAggregateZero,
483 ConstantArray,
484 ConstantDataArray,
485 ConstantDataVector,
486 ConstantExpr,
487 ConstantFP,
488 ConstantInt,
489 ConstantPointerNull,
490 ConstantStruct,
491 ConstantVector,
492 Function,
493 GlobalAlias,
494 GlobalVariable,
495 UndefValue,
496 Instruction
497 };
498
499 /* llvalue -> ValueKind.t */
500 #define DEFINE_CASE(Val, Kind) \
501 do {if (LLVMIsA##Kind(Val)) CAMLreturn(Val_int(Kind));} while(0)
502
llvm_classify_value(LLVMValueRef Val)503 CAMLprim value llvm_classify_value(LLVMValueRef Val) {
504 CAMLparam0();
505 if (!Val)
506 CAMLreturn(Val_int(NullValue));
507 if (LLVMIsAConstant(Val)) {
508 DEFINE_CASE(Val, BlockAddress);
509 DEFINE_CASE(Val, ConstantAggregateZero);
510 DEFINE_CASE(Val, ConstantArray);
511 DEFINE_CASE(Val, ConstantDataArray);
512 DEFINE_CASE(Val, ConstantDataVector);
513 DEFINE_CASE(Val, ConstantExpr);
514 DEFINE_CASE(Val, ConstantFP);
515 DEFINE_CASE(Val, ConstantInt);
516 DEFINE_CASE(Val, ConstantPointerNull);
517 DEFINE_CASE(Val, ConstantStruct);
518 DEFINE_CASE(Val, ConstantVector);
519 }
520 if (LLVMIsAInstruction(Val)) {
521 CAMLlocal1(result);
522 result = caml_alloc_small(1, 0);
523 Store_field(result, 0, Val_int(LLVMGetInstructionOpcode(Val)));
524 CAMLreturn(result);
525 }
526 if (LLVMIsAGlobalValue(Val)) {
527 DEFINE_CASE(Val, Function);
528 DEFINE_CASE(Val, GlobalAlias);
529 DEFINE_CASE(Val, GlobalVariable);
530 }
531 DEFINE_CASE(Val, Argument);
532 DEFINE_CASE(Val, BasicBlock);
533 DEFINE_CASE(Val, InlineAsm);
534 DEFINE_CASE(Val, MDNode);
535 DEFINE_CASE(Val, MDString);
536 DEFINE_CASE(Val, UndefValue);
537 failwith("Unknown Value class");
538 }
539
540 /* llvalue -> string */
llvm_value_name(LLVMValueRef Val)541 CAMLprim value llvm_value_name(LLVMValueRef Val) {
542 return caml_copy_string(LLVMGetValueName(Val));
543 }
544
545 /* string -> llvalue -> unit */
llvm_set_value_name(value Name,LLVMValueRef Val)546 CAMLprim value llvm_set_value_name(value Name, LLVMValueRef Val) {
547 LLVMSetValueName(Val, String_val(Name));
548 return Val_unit;
549 }
550
551 /* llvalue -> unit */
llvm_dump_value(LLVMValueRef Val)552 CAMLprim value llvm_dump_value(LLVMValueRef Val) {
553 LLVMDumpValue(Val);
554 return Val_unit;
555 }
556
557 /* llvalue -> string */
llvm_string_of_llvalue(LLVMValueRef M)558 CAMLprim value llvm_string_of_llvalue(LLVMValueRef M) {
559 CAMLparam0();
560 CAMLlocal1(ValueStr);
561 char* ValueCStr;
562
563 ValueCStr = LLVMPrintValueToString(M);
564 ValueStr = caml_copy_string(ValueCStr);
565 LLVMDisposeMessage(ValueCStr);
566
567 CAMLreturn(ValueStr);
568 }
569
570 /* llvalue -> llvalue -> unit */
llvm_replace_all_uses_with(LLVMValueRef OldVal,LLVMValueRef NewVal)571 CAMLprim value llvm_replace_all_uses_with(LLVMValueRef OldVal,
572 LLVMValueRef NewVal) {
573 LLVMReplaceAllUsesWith(OldVal, NewVal);
574 return Val_unit;
575 }
576
577 /*--... Operations on users ................................................--*/
578
579 /* llvalue -> int -> llvalue */
llvm_operand(LLVMValueRef V,value I)580 CAMLprim LLVMValueRef llvm_operand(LLVMValueRef V, value I) {
581 return LLVMGetOperand(V, Int_val(I));
582 }
583
584 /* llvalue -> int -> lluse */
llvm_operand_use(LLVMValueRef V,value I)585 CAMLprim LLVMUseRef llvm_operand_use(LLVMValueRef V, value I) {
586 return LLVMGetOperandUse(V, Int_val(I));
587 }
588
589 /* llvalue -> int -> llvalue -> unit */
llvm_set_operand(LLVMValueRef U,value I,LLVMValueRef V)590 CAMLprim value llvm_set_operand(LLVMValueRef U, value I, LLVMValueRef V) {
591 LLVMSetOperand(U, Int_val(I), V);
592 return Val_unit;
593 }
594
595 /* llvalue -> int */
llvm_num_operands(LLVMValueRef V)596 CAMLprim value llvm_num_operands(LLVMValueRef V) {
597 return Val_int(LLVMGetNumOperands(V));
598 }
599
600 /*--... Operations on constants of (mostly) any type .......................--*/
601
602 /* llvalue -> bool */
llvm_is_constant(LLVMValueRef Val)603 CAMLprim value llvm_is_constant(LLVMValueRef Val) {
604 return Val_bool(LLVMIsConstant(Val));
605 }
606
607 /* llvalue -> bool */
llvm_is_null(LLVMValueRef Val)608 CAMLprim value llvm_is_null(LLVMValueRef Val) {
609 return Val_bool(LLVMIsNull(Val));
610 }
611
612 /* llvalue -> bool */
llvm_is_undef(LLVMValueRef Val)613 CAMLprim value llvm_is_undef(LLVMValueRef Val) {
614 return Val_bool(LLVMIsUndef(Val));
615 }
616
617 /* llvalue -> Opcode.t */
llvm_constexpr_get_opcode(LLVMValueRef Val)618 CAMLprim value llvm_constexpr_get_opcode(LLVMValueRef Val) {
619 return LLVMIsAConstantExpr(Val) ?
620 Val_int(LLVMGetConstOpcode(Val)) : Val_int(0);
621 }
622
623 /*--... Operations on instructions .........................................--*/
624
625 /* llvalue -> bool */
llvm_has_metadata(LLVMValueRef Val)626 CAMLprim value llvm_has_metadata(LLVMValueRef Val) {
627 return Val_bool(LLVMHasMetadata(Val));
628 }
629
630 /* llvalue -> int -> llvalue option */
llvm_metadata(LLVMValueRef Val,value MDKindID)631 CAMLprim value llvm_metadata(LLVMValueRef Val, value MDKindID) {
632 CAMLparam1(MDKindID);
633 LLVMValueRef MD;
634 if ((MD = LLVMGetMetadata(Val, Int_val(MDKindID)))) {
635 value Option = alloc(1, 0);
636 Field(Option, 0) = (value) MD;
637 CAMLreturn(Option);
638 }
639 CAMLreturn(Val_int(0));
640 }
641
642 /* llvalue -> int -> llvalue -> unit */
llvm_set_metadata(LLVMValueRef Val,value MDKindID,LLVMValueRef MD)643 CAMLprim value llvm_set_metadata(LLVMValueRef Val, value MDKindID,
644 LLVMValueRef MD) {
645 LLVMSetMetadata(Val, Int_val(MDKindID), MD);
646 return Val_unit;
647 }
648
649 /* llvalue -> int -> unit */
llvm_clear_metadata(LLVMValueRef Val,value MDKindID)650 CAMLprim value llvm_clear_metadata(LLVMValueRef Val, value MDKindID) {
651 LLVMSetMetadata(Val, Int_val(MDKindID), NULL);
652 return Val_unit;
653 }
654
655
656 /*--... Operations on metadata .............................................--*/
657
658 /* llcontext -> string -> llvalue */
llvm_mdstring(LLVMContextRef C,value S)659 CAMLprim LLVMValueRef llvm_mdstring(LLVMContextRef C, value S) {
660 return LLVMMDStringInContext(C, String_val(S), caml_string_length(S));
661 }
662
663 /* llcontext -> llvalue array -> llvalue */
llvm_mdnode(LLVMContextRef C,value ElementVals)664 CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) {
665 return LLVMMDNodeInContext(C, (LLVMValueRef*) Op_val(ElementVals),
666 Wosize_val(ElementVals));
667 }
668
669 /* llcontext -> llvalue */
llvm_mdnull(LLVMContextRef C)670 CAMLprim LLVMValueRef llvm_mdnull(LLVMContextRef C) {
671 return NULL;
672 }
673
674 /* llvalue -> string option */
llvm_get_mdstring(LLVMValueRef V)675 CAMLprim value llvm_get_mdstring(LLVMValueRef V) {
676 CAMLparam0();
677 const char *S;
678 unsigned Len;
679
680 if ((S = LLVMGetMDString(V, &Len))) {
681 CAMLlocal2(Option, Str);
682
683 Str = caml_alloc_string(Len);
684 memcpy(String_val(Str), S, Len);
685 Option = alloc(1,0);
686 Store_field(Option, 0, Str);
687 CAMLreturn(Option);
688 }
689 CAMLreturn(Val_int(0));
690 }
691
692 /* llmodule -> string -> llvalue array */
llvm_get_namedmd(LLVMModuleRef M,value Name)693 CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value Name)
694 {
695 CAMLparam1(Name);
696 CAMLlocal1(Nodes);
697 Nodes = alloc(LLVMGetNamedMetadataNumOperands(M, String_val(Name)), 0);
698 LLVMGetNamedMetadataOperands(M, String_val(Name), (LLVMValueRef *) Nodes);
699 CAMLreturn(Nodes);
700 }
701
702 /* llmodule -> string -> llvalue -> unit */
llvm_append_namedmd(LLVMModuleRef M,value Name,LLVMValueRef Val)703 CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef Val) {
704 LLVMAddNamedMetadataOperand(M, String_val(Name), Val);
705 return Val_unit;
706 }
707
708 /*--... Operations on scalar constants .....................................--*/
709
710 /* lltype -> int -> llvalue */
llvm_const_int(LLVMTypeRef IntTy,value N)711 CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) {
712 return LLVMConstInt(IntTy, (long long) Long_val(N), 1);
713 }
714
715 /* lltype -> Int64.t -> bool -> llvalue */
llvm_const_of_int64(LLVMTypeRef IntTy,value N,value SExt)716 CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
717 value SExt) {
718 return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
719 }
720
721 /* llvalue -> Int64.t */
llvm_int64_of_const(LLVMValueRef Const)722 CAMLprim value llvm_int64_of_const(LLVMValueRef Const)
723 {
724 CAMLparam0();
725 if (LLVMIsAConstantInt(Const) &&
726 LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64) {
727 value Option = alloc(1, 0);
728 Field(Option, 0) = caml_copy_int64(LLVMConstIntGetSExtValue(Const));
729 CAMLreturn(Option);
730 }
731 CAMLreturn(Val_int(0));
732 }
733
734 /* lltype -> string -> int -> llvalue */
llvm_const_int_of_string(LLVMTypeRef IntTy,value S,value Radix)735 CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
736 value Radix) {
737 return LLVMConstIntOfStringAndSize(IntTy, String_val(S), caml_string_length(S),
738 Int_val(Radix));
739 }
740
741 /* lltype -> float -> llvalue */
llvm_const_float(LLVMTypeRef RealTy,value N)742 CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) {
743 return LLVMConstReal(RealTy, Double_val(N));
744 }
745
746
747 /* llvalue -> float */
llvm_float_of_const(LLVMValueRef Const)748 CAMLprim value llvm_float_of_const(LLVMValueRef Const)
749 {
750 CAMLparam0();
751 CAMLlocal1(Option);
752 LLVMBool LosesInfo;
753 double Result;
754
755 if (LLVMIsAConstantFP(Const)) {
756 Result = LLVMConstRealGetDouble(Const, &LosesInfo);
757 if (LosesInfo)
758 CAMLreturn(Val_int(0));
759
760 Option = alloc(1, 0);
761 Field(Option, 0) = caml_copy_double(Result);
762 CAMLreturn(Option);
763 }
764
765 CAMLreturn(Val_int(0));
766 }
767
768 /* lltype -> string -> llvalue */
llvm_const_float_of_string(LLVMTypeRef RealTy,value S)769 CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) {
770 return LLVMConstRealOfStringAndSize(RealTy, String_val(S),
771 caml_string_length(S));
772 }
773
774 /*--... Operations on composite constants ..................................--*/
775
776 /* llcontext -> string -> llvalue */
llvm_const_string(LLVMContextRef Context,value Str,value NullTerminate)777 CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str,
778 value NullTerminate) {
779 return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
780 1);
781 }
782
783 /* llcontext -> string -> llvalue */
llvm_const_stringz(LLVMContextRef Context,value Str,value NullTerminate)784 CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str,
785 value NullTerminate) {
786 return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
787 0);
788 }
789
790 /* lltype -> llvalue array -> llvalue */
llvm_const_array(LLVMTypeRef ElementTy,value ElementVals)791 CAMLprim LLVMValueRef llvm_const_array(LLVMTypeRef ElementTy,
792 value ElementVals) {
793 return LLVMConstArray(ElementTy, (LLVMValueRef*) Op_val(ElementVals),
794 Wosize_val(ElementVals));
795 }
796
797 /* llcontext -> llvalue array -> llvalue */
llvm_const_struct(LLVMContextRef C,value ElementVals)798 CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) {
799 return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
800 Wosize_val(ElementVals), 0);
801 }
802
803 /* lltype -> llvalue array -> llvalue */
llvm_const_named_struct(LLVMTypeRef Ty,value ElementVals)804 CAMLprim LLVMValueRef llvm_const_named_struct(LLVMTypeRef Ty, value ElementVals) {
805 return LLVMConstNamedStruct(Ty, (LLVMValueRef *) Op_val(ElementVals), Wosize_val(ElementVals));
806 }
807
808 /* llcontext -> llvalue array -> llvalue */
llvm_const_packed_struct(LLVMContextRef C,value ElementVals)809 CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C,
810 value ElementVals) {
811 return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
812 Wosize_val(ElementVals), 1);
813 }
814
815 /* llvalue array -> llvalue */
llvm_const_vector(value ElementVals)816 CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
817 return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals),
818 Wosize_val(ElementVals));
819 }
820
821 /* llvalue -> string option */
llvm_string_of_const(LLVMValueRef Const)822 CAMLprim value llvm_string_of_const(LLVMValueRef Const) {
823 const char *S;
824 size_t Len;
825 CAMLparam0();
826 CAMLlocal2(Option, Str);
827
828 if(LLVMIsAConstantDataSequential(Const) && LLVMIsConstantString(Const)) {
829 S = LLVMGetAsString(Const, &Len);
830 Str = caml_alloc_string(Len);
831 memcpy(String_val(Str), S, Len);
832
833 Option = alloc(1, 0);
834 Field(Option, 0) = Str;
835 CAMLreturn(Option);
836 } else {
837 CAMLreturn(Val_int(0));
838 }
839 }
840
841 /* llvalue -> int -> llvalue */
llvm_const_element(LLVMValueRef Const,value N)842 CAMLprim LLVMValueRef llvm_const_element(LLVMValueRef Const, value N) {
843 return LLVMGetElementAsConstant(Const, Int_val(N));
844 }
845
846 /*--... Constant expressions ...............................................--*/
847
848 /* Icmp.t -> llvalue -> llvalue -> llvalue */
llvm_const_icmp(value Pred,LLVMValueRef LHSConstant,LLVMValueRef RHSConstant)849 CAMLprim LLVMValueRef llvm_const_icmp(value Pred,
850 LLVMValueRef LHSConstant,
851 LLVMValueRef RHSConstant) {
852 return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant);
853 }
854
855 /* Fcmp.t -> llvalue -> llvalue -> llvalue */
llvm_const_fcmp(value Pred,LLVMValueRef LHSConstant,LLVMValueRef RHSConstant)856 CAMLprim LLVMValueRef llvm_const_fcmp(value Pred,
857 LLVMValueRef LHSConstant,
858 LLVMValueRef RHSConstant) {
859 return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant);
860 }
861
862 /* llvalue -> llvalue array -> llvalue */
llvm_const_gep(LLVMValueRef ConstantVal,value Indices)863 CAMLprim LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) {
864 return LLVMConstGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
865 Wosize_val(Indices));
866 }
867
868 /* llvalue -> llvalue array -> llvalue */
llvm_const_in_bounds_gep(LLVMValueRef ConstantVal,value Indices)869 CAMLprim LLVMValueRef llvm_const_in_bounds_gep(LLVMValueRef ConstantVal,
870 value Indices) {
871 return LLVMConstInBoundsGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
872 Wosize_val(Indices));
873 }
874
875 /* llvalue -> lltype -> is_signed:bool -> llvalue */
llvm_const_intcast(LLVMValueRef CV,LLVMTypeRef T,value IsSigned)876 CAMLprim LLVMValueRef llvm_const_intcast(LLVMValueRef CV, LLVMTypeRef T,
877 value IsSigned) {
878 return LLVMConstIntCast(CV, T, Bool_val(IsSigned));
879 }
880
881 /* llvalue -> int array -> llvalue */
llvm_const_extractvalue(LLVMValueRef Aggregate,value Indices)882 CAMLprim LLVMValueRef llvm_const_extractvalue(LLVMValueRef Aggregate,
883 value Indices) {
884 CAMLparam1(Indices);
885 int size = Wosize_val(Indices);
886 int i;
887 LLVMValueRef result;
888
889 unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
890 for (i = 0; i < size; i++) {
891 idxs[i] = Int_val(Field(Indices, i));
892 }
893
894 result = LLVMConstExtractValue(Aggregate, idxs, size);
895 free(idxs);
896 CAMLreturnT(LLVMValueRef, result);
897 }
898
899 /* llvalue -> llvalue -> int array -> llvalue */
llvm_const_insertvalue(LLVMValueRef Aggregate,LLVMValueRef Val,value Indices)900 CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate,
901 LLVMValueRef Val, value Indices) {
902 CAMLparam1(Indices);
903 int size = Wosize_val(Indices);
904 int i;
905 LLVMValueRef result;
906
907 unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
908 for (i = 0; i < size; i++) {
909 idxs[i] = Int_val(Field(Indices, i));
910 }
911
912 result = LLVMConstInsertValue(Aggregate, Val, idxs, size);
913 free(idxs);
914 CAMLreturnT(LLVMValueRef, result);
915 }
916
917 /* lltype -> string -> string -> bool -> bool -> llvalue */
llvm_const_inline_asm(LLVMTypeRef Ty,value Asm,value Constraints,value HasSideEffects,value IsAlignStack)918 CAMLprim LLVMValueRef llvm_const_inline_asm(LLVMTypeRef Ty, value Asm,
919 value Constraints, value HasSideEffects,
920 value IsAlignStack) {
921 return LLVMConstInlineAsm(Ty, String_val(Asm), String_val(Constraints),
922 Bool_val(HasSideEffects), Bool_val(IsAlignStack));
923 }
924
925 /*--... Operations on global variables, functions, and aliases (globals) ...--*/
926
927 /* llvalue -> bool */
llvm_is_declaration(LLVMValueRef Global)928 CAMLprim value llvm_is_declaration(LLVMValueRef Global) {
929 return Val_bool(LLVMIsDeclaration(Global));
930 }
931
932 /* llvalue -> Linkage.t */
llvm_linkage(LLVMValueRef Global)933 CAMLprim value llvm_linkage(LLVMValueRef Global) {
934 return Val_int(LLVMGetLinkage(Global));
935 }
936
937 /* Linkage.t -> llvalue -> unit */
llvm_set_linkage(value Linkage,LLVMValueRef Global)938 CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) {
939 LLVMSetLinkage(Global, Int_val(Linkage));
940 return Val_unit;
941 }
942
943 /* llvalue -> string */
llvm_section(LLVMValueRef Global)944 CAMLprim value llvm_section(LLVMValueRef Global) {
945 return caml_copy_string(LLVMGetSection(Global));
946 }
947
948 /* string -> llvalue -> unit */
llvm_set_section(value Section,LLVMValueRef Global)949 CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) {
950 LLVMSetSection(Global, String_val(Section));
951 return Val_unit;
952 }
953
954 /* llvalue -> Visibility.t */
llvm_visibility(LLVMValueRef Global)955 CAMLprim value llvm_visibility(LLVMValueRef Global) {
956 return Val_int(LLVMGetVisibility(Global));
957 }
958
959 /* Visibility.t -> llvalue -> unit */
llvm_set_visibility(value Viz,LLVMValueRef Global)960 CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) {
961 LLVMSetVisibility(Global, Int_val(Viz));
962 return Val_unit;
963 }
964
965 /* llvalue -> DLLStorageClass.t */
llvm_dll_storage_class(LLVMValueRef Global)966 CAMLprim value llvm_dll_storage_class(LLVMValueRef Global) {
967 return Val_int(LLVMGetDLLStorageClass(Global));
968 }
969
970 /* DLLStorageClass.t -> llvalue -> unit */
llvm_set_dll_storage_class(value Viz,LLVMValueRef Global)971 CAMLprim value llvm_set_dll_storage_class(value Viz, LLVMValueRef Global) {
972 LLVMSetDLLStorageClass(Global, Int_val(Viz));
973 return Val_unit;
974 }
975
976 /* llvalue -> int */
llvm_alignment(LLVMValueRef Global)977 CAMLprim value llvm_alignment(LLVMValueRef Global) {
978 return Val_int(LLVMGetAlignment(Global));
979 }
980
981 /* int -> llvalue -> unit */
llvm_set_alignment(value Bytes,LLVMValueRef Global)982 CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
983 LLVMSetAlignment(Global, Int_val(Bytes));
984 return Val_unit;
985 }
986
987 /*--... Operations on uses .................................................--*/
988
989 /* llvalue -> lluse option */
llvm_use_begin(LLVMValueRef Val)990 CAMLprim value llvm_use_begin(LLVMValueRef Val) {
991 CAMLparam0();
992 LLVMUseRef First;
993 if ((First = LLVMGetFirstUse(Val))) {
994 value Option = alloc(1, 0);
995 Field(Option, 0) = (value) First;
996 CAMLreturn(Option);
997 }
998 CAMLreturn(Val_int(0));
999 }
1000
1001 /* lluse -> lluse option */
llvm_use_succ(LLVMUseRef U)1002 CAMLprim value llvm_use_succ(LLVMUseRef U) {
1003 CAMLparam0();
1004 LLVMUseRef Next;
1005 if ((Next = LLVMGetNextUse(U))) {
1006 value Option = alloc(1, 0);
1007 Field(Option, 0) = (value) Next;
1008 CAMLreturn(Option);
1009 }
1010 CAMLreturn(Val_int(0));
1011 }
1012
1013 /* lluse -> llvalue */
llvm_user(LLVMUseRef UR)1014 CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) {
1015 return LLVMGetUser(UR);
1016 }
1017
1018 /* lluse -> llvalue */
llvm_used_value(LLVMUseRef UR)1019 CAMLprim LLVMValueRef llvm_used_value(LLVMUseRef UR) {
1020 return LLVMGetUsedValue(UR);
1021 }
1022
1023 /*--... Operations on global variables .....................................--*/
1024
DEFINE_ITERATORS(global,Global,LLVMModuleRef,LLVMValueRef,LLVMGetGlobalParent)1025 DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef,
1026 LLVMGetGlobalParent)
1027
1028 /* lltype -> string -> llmodule -> llvalue */
1029 CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
1030 LLVMModuleRef M) {
1031 LLVMValueRef GlobalVar;
1032 if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
1033 if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
1034 return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty, 0));
1035 return GlobalVar;
1036 }
1037 return LLVMAddGlobal(M, Ty, String_val(Name));
1038 }
1039
1040 /* lltype -> string -> int -> llmodule -> llvalue */
llvm_declare_qualified_global(LLVMTypeRef Ty,value Name,value AddressSpace,LLVMModuleRef M)1041 CAMLprim LLVMValueRef llvm_declare_qualified_global(LLVMTypeRef Ty, value Name,
1042 value AddressSpace,
1043 LLVMModuleRef M) {
1044 LLVMValueRef GlobalVar;
1045 if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
1046 if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
1047 return LLVMConstBitCast(GlobalVar,
1048 LLVMPointerType(Ty, Int_val(AddressSpace)));
1049 return GlobalVar;
1050 }
1051 return LLVMAddGlobalInAddressSpace(M, Ty, String_val(Name),
1052 Int_val(AddressSpace));
1053 }
1054
1055 /* string -> llmodule -> llvalue option */
llvm_lookup_global(value Name,LLVMModuleRef M)1056 CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
1057 CAMLparam1(Name);
1058 LLVMValueRef GlobalVar;
1059 if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
1060 value Option = alloc(1, 0);
1061 Field(Option, 0) = (value) GlobalVar;
1062 CAMLreturn(Option);
1063 }
1064 CAMLreturn(Val_int(0));
1065 }
1066
1067 /* string -> llvalue -> llmodule -> llvalue */
llvm_define_global(value Name,LLVMValueRef Initializer,LLVMModuleRef M)1068 CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
1069 LLVMModuleRef M) {
1070 LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer),
1071 String_val(Name));
1072 LLVMSetInitializer(GlobalVar, Initializer);
1073 return GlobalVar;
1074 }
1075
1076 /* string -> llvalue -> int -> llmodule -> llvalue */
llvm_define_qualified_global(value Name,LLVMValueRef Initializer,value AddressSpace,LLVMModuleRef M)1077 CAMLprim LLVMValueRef llvm_define_qualified_global(value Name,
1078 LLVMValueRef Initializer,
1079 value AddressSpace,
1080 LLVMModuleRef M) {
1081 LLVMValueRef GlobalVar = LLVMAddGlobalInAddressSpace(M,
1082 LLVMTypeOf(Initializer),
1083 String_val(Name),
1084 Int_val(AddressSpace));
1085 LLVMSetInitializer(GlobalVar, Initializer);
1086 return GlobalVar;
1087 }
1088
1089 /* llvalue -> unit */
llvm_delete_global(LLVMValueRef GlobalVar)1090 CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) {
1091 LLVMDeleteGlobal(GlobalVar);
1092 return Val_unit;
1093 }
1094
1095 /* llvalue -> llvalue -> unit */
llvm_set_initializer(LLVMValueRef ConstantVal,LLVMValueRef GlobalVar)1096 CAMLprim value llvm_set_initializer(LLVMValueRef ConstantVal,
1097 LLVMValueRef GlobalVar) {
1098 LLVMSetInitializer(GlobalVar, ConstantVal);
1099 return Val_unit;
1100 }
1101
1102 /* llvalue -> unit */
llvm_remove_initializer(LLVMValueRef GlobalVar)1103 CAMLprim value llvm_remove_initializer(LLVMValueRef GlobalVar) {
1104 LLVMSetInitializer(GlobalVar, NULL);
1105 return Val_unit;
1106 }
1107
1108 /* llvalue -> bool */
llvm_is_thread_local(LLVMValueRef GlobalVar)1109 CAMLprim value llvm_is_thread_local(LLVMValueRef GlobalVar) {
1110 return Val_bool(LLVMIsThreadLocal(GlobalVar));
1111 }
1112
1113 /* bool -> llvalue -> unit */
llvm_set_thread_local(value IsThreadLocal,LLVMValueRef GlobalVar)1114 CAMLprim value llvm_set_thread_local(value IsThreadLocal,
1115 LLVMValueRef GlobalVar) {
1116 LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal));
1117 return Val_unit;
1118 }
1119
1120 /* llvalue -> ThreadLocalMode.t */
llvm_thread_local_mode(LLVMValueRef GlobalVar)1121 CAMLprim value llvm_thread_local_mode(LLVMValueRef GlobalVar) {
1122 return Val_int(LLVMGetThreadLocalMode(GlobalVar));
1123 }
1124
1125 /* ThreadLocalMode.t -> llvalue -> unit */
llvm_set_thread_local_mode(value ThreadLocalMode,LLVMValueRef GlobalVar)1126 CAMLprim value llvm_set_thread_local_mode(value ThreadLocalMode,
1127 LLVMValueRef GlobalVar) {
1128 LLVMSetThreadLocalMode(GlobalVar, Int_val(ThreadLocalMode));
1129 return Val_unit;
1130 }
1131
1132 /* llvalue -> bool */
llvm_is_externally_initialized(LLVMValueRef GlobalVar)1133 CAMLprim value llvm_is_externally_initialized(LLVMValueRef GlobalVar) {
1134 return Val_bool(LLVMIsExternallyInitialized(GlobalVar));
1135 }
1136
1137 /* bool -> llvalue -> unit */
llvm_set_externally_initialized(value IsExternallyInitialized,LLVMValueRef GlobalVar)1138 CAMLprim value llvm_set_externally_initialized(value IsExternallyInitialized,
1139 LLVMValueRef GlobalVar) {
1140 LLVMSetExternallyInitialized(GlobalVar, Bool_val(IsExternallyInitialized));
1141 return Val_unit;
1142 }
1143
1144 /* llvalue -> bool */
llvm_is_global_constant(LLVMValueRef GlobalVar)1145 CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) {
1146 return Val_bool(LLVMIsGlobalConstant(GlobalVar));
1147 }
1148
1149 /* bool -> llvalue -> unit */
llvm_set_global_constant(value Flag,LLVMValueRef GlobalVar)1150 CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
1151 LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag));
1152 return Val_unit;
1153 }
1154
1155 /*--... Operations on aliases ..............................................--*/
1156
llvm_add_alias(LLVMModuleRef M,LLVMTypeRef Ty,LLVMValueRef Aliasee,value Name)1157 CAMLprim LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty,
1158 LLVMValueRef Aliasee, value Name) {
1159 return LLVMAddAlias(M, Ty, Aliasee, String_val(Name));
1160 }
1161
1162 /*--... Operations on functions ............................................--*/
1163
DEFINE_ITERATORS(function,Function,LLVMModuleRef,LLVMValueRef,LLVMGetGlobalParent)1164 DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef,
1165 LLVMGetGlobalParent)
1166
1167 /* string -> lltype -> llmodule -> llvalue */
1168 CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
1169 LLVMModuleRef M) {
1170 LLVMValueRef Fn;
1171 if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
1172 if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
1173 return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0));
1174 return Fn;
1175 }
1176 return LLVMAddFunction(M, String_val(Name), Ty);
1177 }
1178
1179 /* string -> llmodule -> llvalue option */
llvm_lookup_function(value Name,LLVMModuleRef M)1180 CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
1181 CAMLparam1(Name);
1182 LLVMValueRef Fn;
1183 if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
1184 value Option = alloc(1, 0);
1185 Field(Option, 0) = (value) Fn;
1186 CAMLreturn(Option);
1187 }
1188 CAMLreturn(Val_int(0));
1189 }
1190
1191 /* string -> lltype -> llmodule -> llvalue */
llvm_define_function(value Name,LLVMTypeRef Ty,LLVMModuleRef M)1192 CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
1193 LLVMModuleRef M) {
1194 LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
1195 LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry");
1196 return Fn;
1197 }
1198
1199 /* llvalue -> unit */
llvm_delete_function(LLVMValueRef Fn)1200 CAMLprim value llvm_delete_function(LLVMValueRef Fn) {
1201 LLVMDeleteFunction(Fn);
1202 return Val_unit;
1203 }
1204
1205 /* llvalue -> bool */
llvm_is_intrinsic(LLVMValueRef Fn)1206 CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) {
1207 return Val_bool(LLVMGetIntrinsicID(Fn));
1208 }
1209
1210 /* llvalue -> int */
llvm_function_call_conv(LLVMValueRef Fn)1211 CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) {
1212 return Val_int(LLVMGetFunctionCallConv(Fn));
1213 }
1214
1215 /* int -> llvalue -> unit */
llvm_set_function_call_conv(value Id,LLVMValueRef Fn)1216 CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) {
1217 LLVMSetFunctionCallConv(Fn, Int_val(Id));
1218 return Val_unit;
1219 }
1220
1221 /* llvalue -> string option */
llvm_gc(LLVMValueRef Fn)1222 CAMLprim value llvm_gc(LLVMValueRef Fn) {
1223 const char *GC;
1224 CAMLparam0();
1225 CAMLlocal2(Name, Option);
1226
1227 if ((GC = LLVMGetGC(Fn))) {
1228 Name = caml_copy_string(GC);
1229
1230 Option = alloc(1, 0);
1231 Field(Option, 0) = Name;
1232 CAMLreturn(Option);
1233 } else {
1234 CAMLreturn(Val_int(0));
1235 }
1236 }
1237
1238 /* string option -> llvalue -> unit */
llvm_set_gc(value GC,LLVMValueRef Fn)1239 CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
1240 LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0)));
1241 return Val_unit;
1242 }
1243
1244 /* llvalue -> int32 -> unit */
llvm_add_function_attr(LLVMValueRef Arg,value PA)1245 CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
1246 LLVMAddFunctionAttr(Arg, Int32_val(PA));
1247 return Val_unit;
1248 }
1249
1250 /* llvalue -> string -> string -> unit */
llvm_add_target_dependent_function_attr(LLVMValueRef Arg,value A,value V)1251 CAMLprim value llvm_add_target_dependent_function_attr(
1252 LLVMValueRef Arg, value A, value V) {
1253 LLVMAddTargetDependentFunctionAttr(Arg, String_val(A), String_val(V));
1254 return Val_unit;
1255 }
1256
1257 /* llvalue -> int32 */
llvm_function_attr(LLVMValueRef Fn)1258 CAMLprim value llvm_function_attr(LLVMValueRef Fn)
1259 {
1260 CAMLparam0();
1261 CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
1262 }
1263
1264 /* llvalue -> int32 -> unit */
llvm_remove_function_attr(LLVMValueRef Arg,value PA)1265 CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
1266 LLVMRemoveFunctionAttr(Arg, Int32_val(PA));
1267 return Val_unit;
1268 }
1269 /*--... Operations on parameters ...........................................--*/
1270
DEFINE_ITERATORS(param,Param,LLVMValueRef,LLVMValueRef,LLVMGetParamParent)1271 DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
1272
1273 /* llvalue -> int -> llvalue */
1274 CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
1275 return LLVMGetParam(Fn, Int_val(Index));
1276 }
1277
1278 /* llvalue -> int */
llvm_param_attr(LLVMValueRef Param)1279 CAMLprim value llvm_param_attr(LLVMValueRef Param)
1280 {
1281 CAMLparam0();
1282 CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
1283 }
1284
1285 /* llvalue -> llvalue */
llvm_params(LLVMValueRef Fn)1286 CAMLprim value llvm_params(LLVMValueRef Fn) {
1287 value Params = alloc(LLVMCountParams(Fn), 0);
1288 LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
1289 return Params;
1290 }
1291
1292 /* llvalue -> int32 -> unit */
llvm_add_param_attr(LLVMValueRef Arg,value PA)1293 CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
1294 LLVMAddAttribute(Arg, Int32_val(PA));
1295 return Val_unit;
1296 }
1297
1298 /* llvalue -> int32 -> unit */
llvm_remove_param_attr(LLVMValueRef Arg,value PA)1299 CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
1300 LLVMRemoveAttribute(Arg, Int32_val(PA));
1301 return Val_unit;
1302 }
1303
1304 /* llvalue -> int -> unit */
llvm_set_param_alignment(LLVMValueRef Arg,value align)1305 CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
1306 LLVMSetParamAlignment(Arg, Int_val(align));
1307 return Val_unit;
1308 }
1309
1310 /*--... Operations on basic blocks .........................................--*/
1311
DEFINE_ITERATORS(block,BasicBlock,LLVMValueRef,LLVMBasicBlockRef,LLVMGetBasicBlockParent)1312 DEFINE_ITERATORS(
1313 block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
1314
1315 /* llbasicblock -> llvalue option */
1316 CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
1317 {
1318 CAMLparam0();
1319 LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
1320 if (Term) {
1321 value Option = alloc(1, 0);
1322 Field(Option, 0) = (value) Term;
1323 CAMLreturn(Option);
1324 }
1325 CAMLreturn(Val_int(0));
1326 }
1327
1328 /* llvalue -> llbasicblock array */
llvm_basic_blocks(LLVMValueRef Fn)1329 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
1330 value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
1331 LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
1332 return MLArray;
1333 }
1334
1335 /* llbasicblock -> unit */
llvm_delete_block(LLVMBasicBlockRef BB)1336 CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
1337 LLVMDeleteBasicBlock(BB);
1338 return Val_unit;
1339 }
1340
1341 /* llbasicblock -> unit */
llvm_remove_block(LLVMBasicBlockRef BB)1342 CAMLprim value llvm_remove_block(LLVMBasicBlockRef BB) {
1343 LLVMRemoveBasicBlockFromParent(BB);
1344 return Val_unit;
1345 }
1346
1347 /* llbasicblock -> llbasicblock -> unit */
llvm_move_block_before(LLVMBasicBlockRef Pos,LLVMBasicBlockRef BB)1348 CAMLprim value llvm_move_block_before(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1349 LLVMMoveBasicBlockBefore(BB, Pos);
1350 return Val_unit;
1351 }
1352
1353 /* llbasicblock -> llbasicblock -> unit */
llvm_move_block_after(LLVMBasicBlockRef Pos,LLVMBasicBlockRef BB)1354 CAMLprim value llvm_move_block_after(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1355 LLVMMoveBasicBlockAfter(BB, Pos);
1356 return Val_unit;
1357 }
1358
1359 /* string -> llvalue -> llbasicblock */
llvm_append_block(LLVMContextRef Context,value Name,LLVMValueRef Fn)1360 CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
1361 LLVMValueRef Fn) {
1362 return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name));
1363 }
1364
1365 /* string -> llbasicblock -> llbasicblock */
llvm_insert_block(LLVMContextRef Context,value Name,LLVMBasicBlockRef BB)1366 CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name,
1367 LLVMBasicBlockRef BB) {
1368 return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name));
1369 }
1370
1371 /* llvalue -> bool */
llvm_value_is_block(LLVMValueRef Val)1372 CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
1373 return Val_bool(LLVMValueIsBasicBlock(Val));
1374 }
1375
1376 /*--... Operations on instructions .........................................--*/
1377
DEFINE_ITERATORS(instr,Instruction,LLVMBasicBlockRef,LLVMValueRef,LLVMGetInstructionParent)1378 DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
1379 LLVMGetInstructionParent)
1380
1381 /* llvalue -> Opcode.t */
1382 CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
1383 LLVMOpcode o;
1384 if (!LLVMIsAInstruction(Inst))
1385 failwith("Not an instruction");
1386 o = LLVMGetInstructionOpcode(Inst);
1387 assert (o <= LLVMLandingPad);
1388 return Val_int(o);
1389 }
1390
1391 /* llvalue -> ICmp.t option */
llvm_instr_icmp_predicate(LLVMValueRef Val)1392 CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
1393 CAMLparam0();
1394 int x = LLVMGetICmpPredicate(Val);
1395 if (x) {
1396 value Option = alloc(1, 0);
1397 Field(Option, 0) = Val_int(x - LLVMIntEQ);
1398 CAMLreturn(Option);
1399 }
1400 CAMLreturn(Val_int(0));
1401 }
1402
1403 /* llvalue -> FCmp.t option */
llvm_instr_fcmp_predicate(LLVMValueRef Val)1404 CAMLprim value llvm_instr_fcmp_predicate(LLVMValueRef Val) {
1405 CAMLparam0();
1406 int x = LLVMGetFCmpPredicate(Val);
1407 if (x) {
1408 value Option = alloc(1, 0);
1409 Field(Option, 0) = Val_int(x - LLVMRealPredicateFalse);
1410 CAMLreturn(Option);
1411 }
1412 CAMLreturn(Val_int(0));
1413 }
1414
1415 /* llvalue -> llvalue */
llvm_instr_clone(LLVMValueRef Inst)1416 CAMLprim LLVMValueRef llvm_instr_clone(LLVMValueRef Inst) {
1417 if (!LLVMIsAInstruction(Inst))
1418 failwith("Not an instruction");
1419 return LLVMInstructionClone(Inst);
1420 }
1421
1422
1423 /*--... Operations on call sites ...........................................--*/
1424
1425 /* llvalue -> int */
llvm_instruction_call_conv(LLVMValueRef Inst)1426 CAMLprim value llvm_instruction_call_conv(LLVMValueRef Inst) {
1427 return Val_int(LLVMGetInstructionCallConv(Inst));
1428 }
1429
1430 /* int -> llvalue -> unit */
llvm_set_instruction_call_conv(value CC,LLVMValueRef Inst)1431 CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
1432 LLVMSetInstructionCallConv(Inst, Int_val(CC));
1433 return Val_unit;
1434 }
1435
1436 /* llvalue -> int -> int32 -> unit */
llvm_add_instruction_param_attr(LLVMValueRef Instr,value index,value PA)1437 CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
1438 value index,
1439 value PA) {
1440 LLVMAddInstrAttribute(Instr, Int_val(index), Int32_val(PA));
1441 return Val_unit;
1442 }
1443
1444 /* llvalue -> int -> int32 -> unit */
llvm_remove_instruction_param_attr(LLVMValueRef Instr,value index,value PA)1445 CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
1446 value index,
1447 value PA) {
1448 LLVMRemoveInstrAttribute(Instr, Int_val(index), Int32_val(PA));
1449 return Val_unit;
1450 }
1451
1452 /*--... Operations on call instructions (only) .............................--*/
1453
1454 /* llvalue -> bool */
llvm_is_tail_call(LLVMValueRef CallInst)1455 CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) {
1456 return Val_bool(LLVMIsTailCall(CallInst));
1457 }
1458
1459 /* bool -> llvalue -> unit */
llvm_set_tail_call(value IsTailCall,LLVMValueRef CallInst)1460 CAMLprim value llvm_set_tail_call(value IsTailCall,
1461 LLVMValueRef CallInst) {
1462 LLVMSetTailCall(CallInst, Bool_val(IsTailCall));
1463 return Val_unit;
1464 }
1465
1466 /*--... Operations on load/store instructions (only)........................--*/
1467
1468 /* llvalue -> bool */
llvm_is_volatile(LLVMValueRef MemoryInst)1469 CAMLprim value llvm_is_volatile(LLVMValueRef MemoryInst) {
1470 return Val_bool(LLVMGetVolatile(MemoryInst));
1471 }
1472
1473 /* bool -> llvalue -> unit */
llvm_set_volatile(value IsVolatile,LLVMValueRef MemoryInst)1474 CAMLprim value llvm_set_volatile(value IsVolatile,
1475 LLVMValueRef MemoryInst) {
1476 LLVMSetVolatile(MemoryInst, Bool_val(IsVolatile));
1477 return Val_unit;
1478 }
1479
1480
1481 /*--.. Operations on terminators ...........................................--*/
1482
1483 /* llvalue -> int -> llbasicblock */
llvm_successor(LLVMValueRef V,value I)1484 CAMLprim LLVMBasicBlockRef llvm_successor(LLVMValueRef V, value I) {
1485 return LLVMGetSuccessor(V, Int_val(I));
1486 }
1487
1488 /* llvalue -> int -> llvalue -> unit */
llvm_set_successor(LLVMValueRef U,value I,LLVMBasicBlockRef B)1489 CAMLprim value llvm_set_successor(LLVMValueRef U, value I, LLVMBasicBlockRef B) {
1490 LLVMSetSuccessor(U, Int_val(I), B);
1491 return Val_unit;
1492 }
1493
1494 /* llvalue -> int */
llvm_num_successors(LLVMValueRef V)1495 CAMLprim value llvm_num_successors(LLVMValueRef V) {
1496 return Val_int(LLVMGetNumSuccessors(V));
1497 }
1498
1499 /*--.. Operations on branch ................................................--*/
1500
1501 /* llvalue -> llvalue */
llvm_condition(LLVMValueRef V)1502 CAMLprim LLVMValueRef llvm_condition(LLVMValueRef V) {
1503 return LLVMGetCondition(V);
1504 }
1505
1506 /* llvalue -> llvalue -> unit */
llvm_set_condition(LLVMValueRef B,LLVMValueRef C)1507 CAMLprim value llvm_set_condition(LLVMValueRef B, LLVMValueRef C) {
1508 LLVMSetCondition(B, C);
1509 return Val_unit;
1510 }
1511
1512 /* llvalue -> bool */
llvm_is_conditional(LLVMValueRef V)1513 CAMLprim value llvm_is_conditional(LLVMValueRef V) {
1514 return Val_bool(LLVMIsConditional(V));
1515 }
1516
1517 /*--... Operations on phi nodes ............................................--*/
1518
1519 /* (llvalue * llbasicblock) -> llvalue -> unit */
llvm_add_incoming(value Incoming,LLVMValueRef PhiNode)1520 CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
1521 LLVMAddIncoming(PhiNode,
1522 (LLVMValueRef*) &Field(Incoming, 0),
1523 (LLVMBasicBlockRef*) &Field(Incoming, 1),
1524 1);
1525 return Val_unit;
1526 }
1527
1528 /* llvalue -> (llvalue * llbasicblock) list */
llvm_incoming(LLVMValueRef PhiNode)1529 CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
1530 unsigned I;
1531 CAMLparam0();
1532 CAMLlocal3(Hd, Tl, Tmp);
1533
1534 /* Build a tuple list of them. */
1535 Tl = Val_int(0);
1536 for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
1537 Hd = alloc(2, 0);
1538 Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
1539 Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
1540
1541 Tmp = alloc(2, 0);
1542 Store_field(Tmp, 0, Hd);
1543 Store_field(Tmp, 1, Tl);
1544 Tl = Tmp;
1545 }
1546
1547 CAMLreturn(Tl);
1548 }
1549
1550 /* llvalue -> unit */
llvm_delete_instruction(LLVMValueRef Instruction)1551 CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
1552 LLVMInstructionEraseFromParent(Instruction);
1553 return Val_unit;
1554 }
1555
1556 /*===-- Instruction builders ----------------------------------------------===*/
1557
1558 #define Builder_val(v) (*(LLVMBuilderRef *)(Data_custom_val(v)))
1559
llvm_finalize_builder(value B)1560 static void llvm_finalize_builder(value B) {
1561 LLVMDisposeBuilder(Builder_val(B));
1562 }
1563
1564 static struct custom_operations builder_ops = {
1565 (char *) "Llvm.llbuilder",
1566 llvm_finalize_builder,
1567 custom_compare_default,
1568 custom_hash_default,
1569 custom_serialize_default,
1570 custom_deserialize_default,
1571 custom_compare_ext_default
1572 };
1573
alloc_builder(LLVMBuilderRef B)1574 static value alloc_builder(LLVMBuilderRef B) {
1575 value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
1576 Builder_val(V) = B;
1577 return V;
1578 }
1579
1580 /* llcontext -> llbuilder */
llvm_builder(LLVMContextRef C)1581 CAMLprim value llvm_builder(LLVMContextRef C) {
1582 return alloc_builder(LLVMCreateBuilderInContext(C));
1583 }
1584
1585 /* (llbasicblock, llvalue) llpos -> llbuilder -> unit */
llvm_position_builder(value Pos,value B)1586 CAMLprim value llvm_position_builder(value Pos, value B) {
1587 if (Tag_val(Pos) == 0) {
1588 LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0));
1589 LLVMPositionBuilderAtEnd(Builder_val(B), BB);
1590 } else {
1591 LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0));
1592 LLVMPositionBuilderBefore(Builder_val(B), I);
1593 }
1594 return Val_unit;
1595 }
1596
1597 /* llbuilder -> llbasicblock */
llvm_insertion_block(value B)1598 CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) {
1599 LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
1600 if (!InsertBlock)
1601 caml_raise_not_found();
1602 return InsertBlock;
1603 }
1604
1605 /* llvalue -> string -> llbuilder -> unit */
llvm_insert_into_builder(LLVMValueRef I,value Name,value B)1606 CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) {
1607 LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name));
1608 return Val_unit;
1609 }
1610
1611 /*--... Metadata ...........................................................--*/
1612
1613 /* llbuilder -> llvalue -> unit */
llvm_set_current_debug_location(value B,LLVMValueRef V)1614 CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) {
1615 LLVMSetCurrentDebugLocation(Builder_val(B), V);
1616 return Val_unit;
1617 }
1618
1619 /* llbuilder -> unit */
llvm_clear_current_debug_location(value B)1620 CAMLprim value llvm_clear_current_debug_location(value B) {
1621 LLVMSetCurrentDebugLocation(Builder_val(B), NULL);
1622 return Val_unit;
1623 }
1624
1625 /* llbuilder -> llvalue option */
llvm_current_debug_location(value B)1626 CAMLprim value llvm_current_debug_location(value B) {
1627 CAMLparam0();
1628 LLVMValueRef L;
1629 if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) {
1630 value Option = alloc(1, 0);
1631 Field(Option, 0) = (value) L;
1632 CAMLreturn(Option);
1633 }
1634 CAMLreturn(Val_int(0));
1635 }
1636
1637 /* llbuilder -> llvalue -> unit */
llvm_set_inst_debug_location(value B,LLVMValueRef V)1638 CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) {
1639 LLVMSetInstDebugLocation(Builder_val(B), V);
1640 return Val_unit;
1641 }
1642
1643
1644 /*--... Terminators ........................................................--*/
1645
1646 /* llbuilder -> llvalue */
llvm_build_ret_void(value B)1647 CAMLprim LLVMValueRef llvm_build_ret_void(value B) {
1648 return LLVMBuildRetVoid(Builder_val(B));
1649 }
1650
1651 /* llvalue -> llbuilder -> llvalue */
llvm_build_ret(LLVMValueRef Val,value B)1652 CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) {
1653 return LLVMBuildRet(Builder_val(B), Val);
1654 }
1655
1656 /* llvalue array -> llbuilder -> llvalue */
llvm_build_aggregate_ret(value RetVals,value B)1657 CAMLprim LLVMValueRef llvm_build_aggregate_ret(value RetVals, value B) {
1658 return LLVMBuildAggregateRet(Builder_val(B), (LLVMValueRef *) Op_val(RetVals),
1659 Wosize_val(RetVals));
1660 }
1661
1662 /* llbasicblock -> llbuilder -> llvalue */
llvm_build_br(LLVMBasicBlockRef BB,value B)1663 CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) {
1664 return LLVMBuildBr(Builder_val(B), BB);
1665 }
1666
1667 /* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */
llvm_build_cond_br(LLVMValueRef If,LLVMBasicBlockRef Then,LLVMBasicBlockRef Else,value B)1668 CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If,
1669 LLVMBasicBlockRef Then,
1670 LLVMBasicBlockRef Else,
1671 value B) {
1672 return LLVMBuildCondBr(Builder_val(B), If, Then, Else);
1673 }
1674
1675 /* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */
llvm_build_switch(LLVMValueRef Of,LLVMBasicBlockRef Else,value EstimatedCount,value B)1676 CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
1677 LLVMBasicBlockRef Else,
1678 value EstimatedCount,
1679 value B) {
1680 return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
1681 }
1682
1683 /* lltype -> string -> llbuilder -> llvalue */
llvm_build_malloc(LLVMTypeRef Ty,value Name,value B)1684 CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
1685 value B)
1686 {
1687 return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
1688 }
1689
1690 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_array_malloc(LLVMTypeRef Ty,LLVMValueRef Val,value Name,value B)1691 CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
1692 LLVMValueRef Val,
1693 value Name, value B)
1694 {
1695 return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
1696 }
1697
1698 /* llvalue -> llbuilder -> llvalue */
llvm_build_free(LLVMValueRef P,value B)1699 CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
1700 {
1701 return LLVMBuildFree(Builder_val(B), P);
1702 }
1703
1704 /* llvalue -> llvalue -> llbasicblock -> unit */
llvm_add_case(LLVMValueRef Switch,LLVMValueRef OnVal,LLVMBasicBlockRef Dest)1705 CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
1706 LLVMBasicBlockRef Dest) {
1707 LLVMAddCase(Switch, OnVal, Dest);
1708 return Val_unit;
1709 }
1710
1711 /* llvalue -> llbasicblock -> llbuilder -> llvalue */
llvm_build_indirect_br(LLVMValueRef Addr,value EstimatedDests,value B)1712 CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr,
1713 value EstimatedDests,
1714 value B) {
1715 return LLVMBuildIndirectBr(Builder_val(B), Addr, EstimatedDests);
1716 }
1717
1718 /* llvalue -> llvalue -> llbasicblock -> unit */
llvm_add_destination(LLVMValueRef IndirectBr,LLVMBasicBlockRef Dest)1719 CAMLprim value llvm_add_destination(LLVMValueRef IndirectBr,
1720 LLVMBasicBlockRef Dest) {
1721 LLVMAddDestination(IndirectBr, Dest);
1722 return Val_unit;
1723 }
1724
1725 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1726 llbuilder -> llvalue */
llvm_build_invoke_nat(LLVMValueRef Fn,value Args,LLVMBasicBlockRef Then,LLVMBasicBlockRef Catch,value Name,value B)1727 CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
1728 LLVMBasicBlockRef Then,
1729 LLVMBasicBlockRef Catch,
1730 value Name, value B) {
1731 return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Args),
1732 Wosize_val(Args), Then, Catch, String_val(Name));
1733 }
1734
1735 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1736 llbuilder -> llvalue */
llvm_build_invoke_bc(value Args[],int NumArgs)1737 CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
1738 return llvm_build_invoke_nat((LLVMValueRef) Args[0], Args[1],
1739 (LLVMBasicBlockRef) Args[2],
1740 (LLVMBasicBlockRef) Args[3],
1741 Args[4], Args[5]);
1742 }
1743
1744 /* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
llvm_build_landingpad(LLVMTypeRef Ty,LLVMValueRef PersFn,value NumClauses,value Name,value B)1745 CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
1746 value NumClauses, value Name,
1747 value B) {
1748 return LLVMBuildLandingPad(Builder_val(B), Ty, PersFn, Int_val(NumClauses),
1749 String_val(Name));
1750 }
1751
1752 /* llvalue -> llvalue -> unit */
llvm_add_clause(LLVMValueRef LandingPadInst,LLVMValueRef ClauseVal)1753 CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
1754 {
1755 LLVMAddClause(LandingPadInst, ClauseVal);
1756 return Val_unit;
1757 }
1758
1759
1760 /* llvalue -> bool -> unit */
llvm_set_cleanup(LLVMValueRef LandingPadInst,value flag)1761 CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
1762 {
1763 LLVMSetCleanup(LandingPadInst, Bool_val(flag));
1764 return Val_unit;
1765 }
1766
1767 /* llvalue -> llbuilder -> llvalue */
llvm_build_resume(LLVMValueRef Exn,value B)1768 CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
1769 {
1770 return LLVMBuildResume(Builder_val(B), Exn);
1771 }
1772
1773 /* llbuilder -> llvalue */
llvm_build_unreachable(value B)1774 CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
1775 return LLVMBuildUnreachable(Builder_val(B));
1776 }
1777
1778 /*--... Arithmetic .........................................................--*/
1779
1780 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_add(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1781 CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS,
1782 value Name, value B) {
1783 return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name));
1784 }
1785
1786 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_nsw_add(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1787 CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1788 value Name, value B) {
1789 return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1790 }
1791
1792 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_nuw_add(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1793 CAMLprim LLVMValueRef llvm_build_nuw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1794 value Name, value B) {
1795 return LLVMBuildNUWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1796 }
1797
1798 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_fadd(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1799 CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS,
1800 value Name, value B) {
1801 return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name));
1802 }
1803
1804 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_sub(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1805 CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1806 value Name, value B) {
1807 return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name));
1808 }
1809
1810 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_nsw_sub(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1811 CAMLprim LLVMValueRef llvm_build_nsw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1812 value Name, value B) {
1813 return LLVMBuildNSWSub(Builder_val(B), LHS, RHS, String_val(Name));
1814 }
1815
1816 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_nuw_sub(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1817 CAMLprim LLVMValueRef llvm_build_nuw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1818 value Name, value B) {
1819 return LLVMBuildNUWSub(Builder_val(B), LHS, RHS, String_val(Name));
1820 }
1821
1822 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_fsub(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1823 CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS,
1824 value Name, value B) {
1825 return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name));
1826 }
1827
1828 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_mul(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1829 CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1830 value Name, value B) {
1831 return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name));
1832 }
1833
1834 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_nsw_mul(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1835 CAMLprim LLVMValueRef llvm_build_nsw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1836 value Name, value B) {
1837 return LLVMBuildNSWMul(Builder_val(B), LHS, RHS, String_val(Name));
1838 }
1839
1840 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_nuw_mul(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1841 CAMLprim LLVMValueRef llvm_build_nuw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1842 value Name, value B) {
1843 return LLVMBuildNUWMul(Builder_val(B), LHS, RHS, String_val(Name));
1844 }
1845
1846 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_fmul(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1847 CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS,
1848 value Name, value B) {
1849 return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name));
1850 }
1851
1852 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_udiv(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1853 CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS,
1854 value Name, value B) {
1855 return LLVMBuildUDiv(Builder_val(B), LHS, RHS, String_val(Name));
1856 }
1857
1858 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_sdiv(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1859 CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1860 value Name, value B) {
1861 return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1862 }
1863
1864 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_exact_sdiv(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1865 CAMLprim LLVMValueRef llvm_build_exact_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1866 value Name, value B) {
1867 return LLVMBuildExactSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1868 }
1869
1870 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_fdiv(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1871 CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1872 value Name, value B) {
1873 return LLVMBuildFDiv(Builder_val(B), LHS, RHS, String_val(Name));
1874 }
1875
1876 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_urem(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1877 CAMLprim LLVMValueRef llvm_build_urem(LLVMValueRef LHS, LLVMValueRef RHS,
1878 value Name, value B) {
1879 return LLVMBuildURem(Builder_val(B), LHS, RHS, String_val(Name));
1880 }
1881
1882 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_srem(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1883 CAMLprim LLVMValueRef llvm_build_srem(LLVMValueRef LHS, LLVMValueRef RHS,
1884 value Name, value B) {
1885 return LLVMBuildSRem(Builder_val(B), LHS, RHS, String_val(Name));
1886 }
1887
1888 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_frem(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1889 CAMLprim LLVMValueRef llvm_build_frem(LLVMValueRef LHS, LLVMValueRef RHS,
1890 value Name, value B) {
1891 return LLVMBuildFRem(Builder_val(B), LHS, RHS, String_val(Name));
1892 }
1893
1894 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_shl(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1895 CAMLprim LLVMValueRef llvm_build_shl(LLVMValueRef LHS, LLVMValueRef RHS,
1896 value Name, value B) {
1897 return LLVMBuildShl(Builder_val(B), LHS, RHS, String_val(Name));
1898 }
1899
1900 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_lshr(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1901 CAMLprim LLVMValueRef llvm_build_lshr(LLVMValueRef LHS, LLVMValueRef RHS,
1902 value Name, value B) {
1903 return LLVMBuildLShr(Builder_val(B), LHS, RHS, String_val(Name));
1904 }
1905
1906 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_ashr(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1907 CAMLprim LLVMValueRef llvm_build_ashr(LLVMValueRef LHS, LLVMValueRef RHS,
1908 value Name, value B) {
1909 return LLVMBuildAShr(Builder_val(B), LHS, RHS, String_val(Name));
1910 }
1911
1912 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_and(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1913 CAMLprim LLVMValueRef llvm_build_and(LLVMValueRef LHS, LLVMValueRef RHS,
1914 value Name, value B) {
1915 return LLVMBuildAnd(Builder_val(B), LHS, RHS, String_val(Name));
1916 }
1917
1918 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_or(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1919 CAMLprim LLVMValueRef llvm_build_or(LLVMValueRef LHS, LLVMValueRef RHS,
1920 value Name, value B) {
1921 return LLVMBuildOr(Builder_val(B), LHS, RHS, String_val(Name));
1922 }
1923
1924 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_xor(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)1925 CAMLprim LLVMValueRef llvm_build_xor(LLVMValueRef LHS, LLVMValueRef RHS,
1926 value Name, value B) {
1927 return LLVMBuildXor(Builder_val(B), LHS, RHS, String_val(Name));
1928 }
1929
1930 /* llvalue -> string -> llbuilder -> llvalue */
llvm_build_neg(LLVMValueRef X,value Name,value B)1931 CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X,
1932 value Name, value B) {
1933 return LLVMBuildNeg(Builder_val(B), X, String_val(Name));
1934 }
1935
1936 /* llvalue -> string -> llbuilder -> llvalue */
llvm_build_nsw_neg(LLVMValueRef X,value Name,value B)1937 CAMLprim LLVMValueRef llvm_build_nsw_neg(LLVMValueRef X,
1938 value Name, value B) {
1939 return LLVMBuildNSWNeg(Builder_val(B), X, String_val(Name));
1940 }
1941
1942 /* llvalue -> string -> llbuilder -> llvalue */
llvm_build_nuw_neg(LLVMValueRef X,value Name,value B)1943 CAMLprim LLVMValueRef llvm_build_nuw_neg(LLVMValueRef X,
1944 value Name, value B) {
1945 return LLVMBuildNUWNeg(Builder_val(B), X, String_val(Name));
1946 }
1947
1948 /* llvalue -> string -> llbuilder -> llvalue */
llvm_build_fneg(LLVMValueRef X,value Name,value B)1949 CAMLprim LLVMValueRef llvm_build_fneg(LLVMValueRef X,
1950 value Name, value B) {
1951 return LLVMBuildFNeg(Builder_val(B), X, String_val(Name));
1952 }
1953
1954 /* llvalue -> string -> llbuilder -> llvalue */
llvm_build_not(LLVMValueRef X,value Name,value B)1955 CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X,
1956 value Name, value B) {
1957 return LLVMBuildNot(Builder_val(B), X, String_val(Name));
1958 }
1959
1960 /*--... Memory .............................................................--*/
1961
1962 /* lltype -> string -> llbuilder -> llvalue */
llvm_build_alloca(LLVMTypeRef Ty,value Name,value B)1963 CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty,
1964 value Name, value B) {
1965 return LLVMBuildAlloca(Builder_val(B), Ty, String_val(Name));
1966 }
1967
1968 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_array_alloca(LLVMTypeRef Ty,LLVMValueRef Size,value Name,value B)1969 CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size,
1970 value Name, value B) {
1971 return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name));
1972 }
1973
1974 /* llvalue -> string -> llbuilder -> llvalue */
llvm_build_load(LLVMValueRef Pointer,value Name,value B)1975 CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer,
1976 value Name, value B) {
1977 return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name));
1978 }
1979
1980 /* llvalue -> llvalue -> llbuilder -> llvalue */
llvm_build_store(LLVMValueRef Value,LLVMValueRef Pointer,value B)1981 CAMLprim LLVMValueRef llvm_build_store(LLVMValueRef Value, LLVMValueRef Pointer,
1982 value B) {
1983 return LLVMBuildStore(Builder_val(B), Value, Pointer);
1984 }
1985
1986 /* AtomicRMWBinOp.t -> llvalue -> llvalue -> AtomicOrdering.t ->
1987 bool -> llbuilder -> llvalue */
llvm_build_atomicrmw_native(value BinOp,LLVMValueRef Ptr,LLVMValueRef Val,value Ord,value ST,value Name,value B)1988 CAMLprim LLVMValueRef llvm_build_atomicrmw_native(value BinOp, LLVMValueRef Ptr,
1989 LLVMValueRef Val, value Ord,
1990 value ST, value Name, value B) {
1991 LLVMValueRef Instr;
1992 Instr = LLVMBuildAtomicRMW(Builder_val(B), Int_val(BinOp),
1993 Ptr, Val, Int_val(Ord), Bool_val(ST));
1994 LLVMSetValueName(Instr, String_val(Name));
1995 return Instr;
1996 }
1997
llvm_build_atomicrmw_bytecode(value * argv,int argn)1998 CAMLprim LLVMValueRef llvm_build_atomicrmw_bytecode(value *argv, int argn) {
1999 return llvm_build_atomicrmw_native(argv[0], (LLVMValueRef) argv[1],
2000 (LLVMValueRef) argv[2], argv[3],
2001 argv[4], argv[5], argv[6]);
2002 }
2003
2004 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
llvm_build_gep(LLVMValueRef Pointer,value Indices,value Name,value B)2005 CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices,
2006 value Name, value B) {
2007 return LLVMBuildGEP(Builder_val(B), Pointer,
2008 (LLVMValueRef *) Op_val(Indices), Wosize_val(Indices),
2009 String_val(Name));
2010 }
2011
2012 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
llvm_build_in_bounds_gep(LLVMValueRef Pointer,value Indices,value Name,value B)2013 CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer,
2014 value Indices, value Name,
2015 value B) {
2016 return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
2017 (LLVMValueRef *) Op_val(Indices),
2018 Wosize_val(Indices), String_val(Name));
2019 }
2020
2021 /* llvalue -> int -> string -> llbuilder -> llvalue */
llvm_build_struct_gep(LLVMValueRef Pointer,value Index,value Name,value B)2022 CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer,
2023 value Index, value Name,
2024 value B) {
2025 return LLVMBuildStructGEP(Builder_val(B), Pointer,
2026 Int_val(Index), String_val(Name));
2027 }
2028
2029 /* string -> string -> llbuilder -> llvalue */
llvm_build_global_string(value Str,value Name,value B)2030 CAMLprim LLVMValueRef llvm_build_global_string(value Str, value Name, value B) {
2031 return LLVMBuildGlobalString(Builder_val(B), String_val(Str),
2032 String_val(Name));
2033 }
2034
2035 /* string -> string -> llbuilder -> llvalue */
llvm_build_global_stringptr(value Str,value Name,value B)2036 CAMLprim LLVMValueRef llvm_build_global_stringptr(value Str, value Name,
2037 value B) {
2038 return LLVMBuildGlobalStringPtr(Builder_val(B), String_val(Str),
2039 String_val(Name));
2040 }
2041
2042 /*--... Casts ..............................................................--*/
2043
2044 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_trunc(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2045 CAMLprim LLVMValueRef llvm_build_trunc(LLVMValueRef X, LLVMTypeRef Ty,
2046 value Name, value B) {
2047 return LLVMBuildTrunc(Builder_val(B), X, Ty, String_val(Name));
2048 }
2049
2050 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_zext(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2051 CAMLprim LLVMValueRef llvm_build_zext(LLVMValueRef X, LLVMTypeRef Ty,
2052 value Name, value B) {
2053 return LLVMBuildZExt(Builder_val(B), X, Ty, String_val(Name));
2054 }
2055
2056 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_sext(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2057 CAMLprim LLVMValueRef llvm_build_sext(LLVMValueRef X, LLVMTypeRef Ty,
2058 value Name, value B) {
2059 return LLVMBuildSExt(Builder_val(B), X, Ty, String_val(Name));
2060 }
2061
2062 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_fptoui(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2063 CAMLprim LLVMValueRef llvm_build_fptoui(LLVMValueRef X, LLVMTypeRef Ty,
2064 value Name, value B) {
2065 return LLVMBuildFPToUI(Builder_val(B), X, Ty, String_val(Name));
2066 }
2067
2068 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_fptosi(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2069 CAMLprim LLVMValueRef llvm_build_fptosi(LLVMValueRef X, LLVMTypeRef Ty,
2070 value Name, value B) {
2071 return LLVMBuildFPToSI(Builder_val(B), X, Ty, String_val(Name));
2072 }
2073
2074 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_uitofp(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2075 CAMLprim LLVMValueRef llvm_build_uitofp(LLVMValueRef X, LLVMTypeRef Ty,
2076 value Name, value B) {
2077 return LLVMBuildUIToFP(Builder_val(B), X, Ty, String_val(Name));
2078 }
2079
2080 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_sitofp(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2081 CAMLprim LLVMValueRef llvm_build_sitofp(LLVMValueRef X, LLVMTypeRef Ty,
2082 value Name, value B) {
2083 return LLVMBuildSIToFP(Builder_val(B), X, Ty, String_val(Name));
2084 }
2085
2086 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_fptrunc(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2087 CAMLprim LLVMValueRef llvm_build_fptrunc(LLVMValueRef X, LLVMTypeRef Ty,
2088 value Name, value B) {
2089 return LLVMBuildFPTrunc(Builder_val(B), X, Ty, String_val(Name));
2090 }
2091
2092 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_fpext(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2093 CAMLprim LLVMValueRef llvm_build_fpext(LLVMValueRef X, LLVMTypeRef Ty,
2094 value Name, value B) {
2095 return LLVMBuildFPExt(Builder_val(B), X, Ty, String_val(Name));
2096 }
2097
2098 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_prttoint(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2099 CAMLprim LLVMValueRef llvm_build_prttoint(LLVMValueRef X, LLVMTypeRef Ty,
2100 value Name, value B) {
2101 return LLVMBuildPtrToInt(Builder_val(B), X, Ty, String_val(Name));
2102 }
2103
2104 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_inttoptr(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2105 CAMLprim LLVMValueRef llvm_build_inttoptr(LLVMValueRef X, LLVMTypeRef Ty,
2106 value Name, value B) {
2107 return LLVMBuildIntToPtr(Builder_val(B), X, Ty, String_val(Name));
2108 }
2109
2110 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_bitcast(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2111 CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
2112 value Name, value B) {
2113 return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name));
2114 }
2115
2116 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_zext_or_bitcast(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2117 CAMLprim LLVMValueRef llvm_build_zext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
2118 value Name, value B) {
2119 return LLVMBuildZExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
2120 }
2121
2122 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_sext_or_bitcast(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2123 CAMLprim LLVMValueRef llvm_build_sext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
2124 value Name, value B) {
2125 return LLVMBuildSExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
2126 }
2127
2128 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_trunc_or_bitcast(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2129 CAMLprim LLVMValueRef llvm_build_trunc_or_bitcast(LLVMValueRef X,
2130 LLVMTypeRef Ty, value Name,
2131 value B) {
2132 return LLVMBuildTruncOrBitCast(Builder_val(B), X, Ty, String_val(Name));
2133 }
2134
2135 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_pointercast(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2136 CAMLprim LLVMValueRef llvm_build_pointercast(LLVMValueRef X, LLVMTypeRef Ty,
2137 value Name, value B) {
2138 return LLVMBuildPointerCast(Builder_val(B), X, Ty, String_val(Name));
2139 }
2140
2141 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_intcast(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2142 CAMLprim LLVMValueRef llvm_build_intcast(LLVMValueRef X, LLVMTypeRef Ty,
2143 value Name, value B) {
2144 return LLVMBuildIntCast(Builder_val(B), X, Ty, String_val(Name));
2145 }
2146
2147 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_fpcast(LLVMValueRef X,LLVMTypeRef Ty,value Name,value B)2148 CAMLprim LLVMValueRef llvm_build_fpcast(LLVMValueRef X, LLVMTypeRef Ty,
2149 value Name, value B) {
2150 return LLVMBuildFPCast(Builder_val(B), X, Ty, String_val(Name));
2151 }
2152
2153 /*--... Comparisons ........................................................--*/
2154
2155 /* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_icmp(value Pred,LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)2156 CAMLprim LLVMValueRef llvm_build_icmp(value Pred,
2157 LLVMValueRef LHS, LLVMValueRef RHS,
2158 value Name, value B) {
2159 return LLVMBuildICmp(Builder_val(B), Int_val(Pred) + LLVMIntEQ, LHS, RHS,
2160 String_val(Name));
2161 }
2162
2163 /* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_fcmp(value Pred,LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)2164 CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
2165 LLVMValueRef LHS, LLVMValueRef RHS,
2166 value Name, value B) {
2167 return LLVMBuildFCmp(Builder_val(B), Int_val(Pred), LHS, RHS,
2168 String_val(Name));
2169 }
2170
2171 /*--... Miscellaneous instructions .........................................--*/
2172
2173 /* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */
llvm_build_phi(value Incoming,value Name,value B)2174 CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
2175 value Hd, Tl;
2176 LLVMValueRef FirstValue, PhiNode;
2177
2178 assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
2179
2180 Hd = Field(Incoming, 0);
2181 FirstValue = (LLVMValueRef) Field(Hd, 0);
2182 PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
2183 String_val(Name));
2184
2185 for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) {
2186 value Hd = Field(Tl, 0);
2187 LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
2188 (LLVMBasicBlockRef*) &Field(Hd, 1), 1);
2189 }
2190
2191 return PhiNode;
2192 }
2193
2194 /* lltype -> string -> llbuilder -> value */
llvm_build_empty_phi(LLVMTypeRef Type,value Name,value B)2195 CAMLprim LLVMValueRef llvm_build_empty_phi(LLVMTypeRef Type, value Name, value B) {
2196 LLVMValueRef PhiNode;
2197
2198 return LLVMBuildPhi(Builder_val(B), Type, String_val(Name));
2199
2200 return PhiNode;
2201 }
2202
2203 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
llvm_build_call(LLVMValueRef Fn,value Params,value Name,value B)2204 CAMLprim LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params,
2205 value Name, value B) {
2206 return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Params),
2207 Wosize_val(Params), String_val(Name));
2208 }
2209
2210 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_select(LLVMValueRef If,LLVMValueRef Then,LLVMValueRef Else,value Name,value B)2211 CAMLprim LLVMValueRef llvm_build_select(LLVMValueRef If,
2212 LLVMValueRef Then, LLVMValueRef Else,
2213 value Name, value B) {
2214 return LLVMBuildSelect(Builder_val(B), If, Then, Else, String_val(Name));
2215 }
2216
2217 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
llvm_build_va_arg(LLVMValueRef List,LLVMTypeRef Ty,value Name,value B)2218 CAMLprim LLVMValueRef llvm_build_va_arg(LLVMValueRef List, LLVMTypeRef Ty,
2219 value Name, value B) {
2220 return LLVMBuildVAArg(Builder_val(B), List, Ty, String_val(Name));
2221 }
2222
2223 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_extractelement(LLVMValueRef Vec,LLVMValueRef Idx,value Name,value B)2224 CAMLprim LLVMValueRef llvm_build_extractelement(LLVMValueRef Vec,
2225 LLVMValueRef Idx,
2226 value Name, value B) {
2227 return LLVMBuildExtractElement(Builder_val(B), Vec, Idx, String_val(Name));
2228 }
2229
2230 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_insertelement(LLVMValueRef Vec,LLVMValueRef Element,LLVMValueRef Idx,value Name,value B)2231 CAMLprim LLVMValueRef llvm_build_insertelement(LLVMValueRef Vec,
2232 LLVMValueRef Element,
2233 LLVMValueRef Idx,
2234 value Name, value B) {
2235 return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx,
2236 String_val(Name));
2237 }
2238
2239 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_shufflevector(LLVMValueRef V1,LLVMValueRef V2,LLVMValueRef Mask,value Name,value B)2240 CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2,
2241 LLVMValueRef Mask,
2242 value Name, value B) {
2243 return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name));
2244 }
2245
2246 /* llvalue -> int -> string -> llbuilder -> llvalue */
llvm_build_extractvalue(LLVMValueRef Aggregate,value Idx,value Name,value B)2247 CAMLprim LLVMValueRef llvm_build_extractvalue(LLVMValueRef Aggregate,
2248 value Idx, value Name, value B) {
2249 return LLVMBuildExtractValue(Builder_val(B), Aggregate, Int_val(Idx),
2250 String_val(Name));
2251 }
2252
2253 /* llvalue -> llvalue -> int -> string -> llbuilder -> llvalue */
llvm_build_insertvalue(LLVMValueRef Aggregate,LLVMValueRef Val,value Idx,value Name,value B)2254 CAMLprim LLVMValueRef llvm_build_insertvalue(LLVMValueRef Aggregate,
2255 LLVMValueRef Val, value Idx,
2256 value Name, value B) {
2257 return LLVMBuildInsertValue(Builder_val(B), Aggregate, Val, Int_val(Idx),
2258 String_val(Name));
2259 }
2260
2261 /* llvalue -> string -> llbuilder -> llvalue */
llvm_build_is_null(LLVMValueRef Val,value Name,value B)2262 CAMLprim LLVMValueRef llvm_build_is_null(LLVMValueRef Val, value Name,
2263 value B) {
2264 return LLVMBuildIsNull(Builder_val(B), Val, String_val(Name));
2265 }
2266
2267 /* llvalue -> string -> llbuilder -> llvalue */
llvm_build_is_not_null(LLVMValueRef Val,value Name,value B)2268 CAMLprim LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name,
2269 value B) {
2270 return LLVMBuildIsNotNull(Builder_val(B), Val, String_val(Name));
2271 }
2272
2273 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
llvm_build_ptrdiff(LLVMValueRef LHS,LLVMValueRef RHS,value Name,value B)2274 CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS,
2275 value Name, value B) {
2276 return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name));
2277 }
2278
2279 /*===-- Memory buffers ----------------------------------------------------===*/
2280
2281 /* string -> llmemorybuffer
2282 raises IoError msg on error */
llvm_memorybuffer_of_file(value Path)2283 CAMLprim value llvm_memorybuffer_of_file(value Path) {
2284 CAMLparam1(Path);
2285 char *Message;
2286 LLVMMemoryBufferRef MemBuf;
2287
2288 if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path),
2289 &MemBuf, &Message))
2290 llvm_raise(*caml_named_value("Llvm.IoError"), Message);
2291
2292 CAMLreturn((value) MemBuf);
2293 }
2294
2295 /* unit -> llmemorybuffer
2296 raises IoError msg on error */
llvm_memorybuffer_of_stdin(value Unit)2297 CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
2298 char *Message;
2299 LLVMMemoryBufferRef MemBuf;
2300
2301 if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message))
2302 llvm_raise(*caml_named_value("Llvm.IoError"), Message);
2303
2304 return MemBuf;
2305 }
2306
2307 /* ?name:string -> string -> llmemorybuffer */
llvm_memorybuffer_of_string(value Name,value String)2308 CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_string(value Name, value String) {
2309 LLVMMemoryBufferRef MemBuf;
2310 const char *NameCStr;
2311
2312 if(Name == Val_int(0))
2313 NameCStr = "";
2314 else
2315 NameCStr = String_val(Field(Name, 0));
2316
2317 MemBuf = LLVMCreateMemoryBufferWithMemoryRangeCopy(
2318 String_val(String), caml_string_length(String), NameCStr);
2319
2320 return MemBuf;
2321 }
2322
2323 /* llmemorybuffer -> string */
llvm_memorybuffer_as_string(LLVMMemoryBufferRef MemBuf)2324 CAMLprim value llvm_memorybuffer_as_string(LLVMMemoryBufferRef MemBuf) {
2325 value String = caml_alloc_string(LLVMGetBufferSize(MemBuf));
2326 memcpy(String_val(String), LLVMGetBufferStart(MemBuf),
2327 LLVMGetBufferSize(MemBuf));
2328
2329 return String;
2330 }
2331
2332 /* llmemorybuffer -> unit */
llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf)2333 CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) {
2334 LLVMDisposeMemoryBuffer(MemBuf);
2335 return Val_unit;
2336 }
2337
2338 /*===-- Pass Managers -----------------------------------------------------===*/
2339
2340 /* unit -> [ `Module ] PassManager.t */
llvm_passmanager_create(value Unit)2341 CAMLprim LLVMPassManagerRef llvm_passmanager_create(value Unit) {
2342 return LLVMCreatePassManager();
2343 }
2344
2345 /* llmodule -> [ `Function ] PassManager.t -> bool */
llvm_passmanager_run_module(LLVMModuleRef M,LLVMPassManagerRef PM)2346 CAMLprim value llvm_passmanager_run_module(LLVMModuleRef M,
2347 LLVMPassManagerRef PM) {
2348 return Val_bool(LLVMRunPassManager(PM, M));
2349 }
2350
2351 /* [ `Function ] PassManager.t -> bool */
llvm_passmanager_initialize(LLVMPassManagerRef FPM)2352 CAMLprim value llvm_passmanager_initialize(LLVMPassManagerRef FPM) {
2353 return Val_bool(LLVMInitializeFunctionPassManager(FPM));
2354 }
2355
2356 /* llvalue -> [ `Function ] PassManager.t -> bool */
llvm_passmanager_run_function(LLVMValueRef F,LLVMPassManagerRef FPM)2357 CAMLprim value llvm_passmanager_run_function(LLVMValueRef F,
2358 LLVMPassManagerRef FPM) {
2359 return Val_bool(LLVMRunFunctionPassManager(FPM, F));
2360 }
2361
2362 /* [ `Function ] PassManager.t -> bool */
llvm_passmanager_finalize(LLVMPassManagerRef FPM)2363 CAMLprim value llvm_passmanager_finalize(LLVMPassManagerRef FPM) {
2364 return Val_bool(LLVMFinalizeFunctionPassManager(FPM));
2365 }
2366
2367 /* PassManager.any PassManager.t -> unit */
llvm_passmanager_dispose(LLVMPassManagerRef PM)2368 CAMLprim value llvm_passmanager_dispose(LLVMPassManagerRef PM) {
2369 LLVMDisposePassManager(PM);
2370 return Val_unit;
2371 }
2372