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