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