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