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