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