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