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