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