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