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