llvm_ocaml.c revision c3c3be582de556f2a199f9154ec48f00be8eb077 
1/*===-- llvm_ocaml.c - LLVM Ocaml Glue --------------------------*- C++ -*-===*\
2|*                                                                            *|
3|*                     The LLVM Compiler Infrastructure                       *|
4|*                                                                            *|
5|* This file is distributed under the University of Illinois Open Source      *|
6|* License. See LICENSE.TXT for details.                                      *|
7|*                                                                            *|
8|*===----------------------------------------------------------------------===*|
9|*                                                                            *|
10|* This file glues LLVM's ocaml interface to its C interface. These functions *|
11|* are by and large transparent wrappers to the corresponding C functions.    *|
12|*                                                                            *|
13|* Note that these functions intentionally take liberties with the CAMLparamX *|
14|* macros, since most of the parameters are not GC heap objects.              *|
15|*                                                                            *|
16\*===----------------------------------------------------------------------===*/
17
18#include "llvm-c/Core.h"
19#include "caml/alloc.h"
20#include "caml/custom.h"
21#include "caml/memory.h"
22#include "caml/fail.h"
23#include "caml/callback.h"
24#include "llvm/Config/config.h"
25#include <assert.h>
26#include <stdlib.h>
27
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/*===-- Modules -----------------------------------------------------------===*/
114
115/* llcontext -> string -> llmodule */
116CAMLprim LLVMModuleRef llvm_create_module(LLVMContextRef C, value ModuleID) {
117  return LLVMModuleCreateWithNameInContext(String_val(ModuleID), C);
118}
119
120/* llmodule -> unit */
121CAMLprim value llvm_dispose_module(LLVMModuleRef M) {
122  LLVMDisposeModule(M);
123  return Val_unit;
124}
125
126/* llmodule -> string */
127CAMLprim value llvm_target_triple(LLVMModuleRef M) {
128  return copy_string(LLVMGetTarget(M));
129}
130
131/* string -> llmodule -> unit */
132CAMLprim value llvm_set_target_triple(value Trip, LLVMModuleRef M) {
133  LLVMSetTarget(M, String_val(Trip));
134  return Val_unit;
135}
136
137/* llmodule -> string */
138CAMLprim value llvm_data_layout(LLVMModuleRef M) {
139  return copy_string(LLVMGetDataLayout(M));
140}
141
142/* string -> llmodule -> unit */
143CAMLprim value llvm_set_data_layout(value Layout, LLVMModuleRef M) {
144  LLVMSetDataLayout(M, String_val(Layout));
145  return Val_unit;
146}
147
148/* string -> lltype -> llmodule -> bool */
149CAMLprim value llvm_add_type_name(value Name, LLVMTypeRef Ty, LLVMModuleRef M) {
150  int res = LLVMAddTypeName(M, String_val(Name), Ty);
151  return Val_bool(res == 0);
152}
153
154/* string -> llmodule -> unit */
155CAMLprim value llvm_delete_type_name(value Name, LLVMModuleRef M) {
156  LLVMDeleteTypeName(M, String_val(Name));
157  return Val_unit;
158}
159
160/* llmodule -> unit */
161CAMLprim value llvm_dump_module(LLVMModuleRef M) {
162  LLVMDumpModule(M);
163  return Val_unit;
164}
165
166
167/*===-- Types -------------------------------------------------------------===*/
168
169/* lltype -> TypeKind.t */
170CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
171  return Val_int(LLVMGetTypeKind(Ty));
172}
173
174/* lltype -> llcontext */
175CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) {
176  return LLVMGetTypeContext(Ty);
177}
178
179/*--... Operations on integer types ........................................--*/
180
181/* llcontext -> lltype */
182CAMLprim LLVMTypeRef llvm_i1_type (LLVMContextRef Context) {
183  return LLVMInt1TypeInContext(Context);
184}
185
186/* llcontext -> lltype */
187CAMLprim LLVMTypeRef llvm_i8_type (LLVMContextRef Context) {
188  return LLVMInt8TypeInContext(Context);
189}
190
191/* llcontext -> lltype */
192CAMLprim LLVMTypeRef llvm_i16_type (LLVMContextRef Context) {
193  return LLVMInt16TypeInContext(Context);
194}
195
196/* llcontext -> lltype */
197CAMLprim LLVMTypeRef llvm_i32_type (LLVMContextRef Context) {
198  return LLVMInt32TypeInContext(Context);
199}
200
201/* llcontext -> lltype */
202CAMLprim LLVMTypeRef llvm_i64_type (LLVMContextRef Context) {
203  return LLVMInt64TypeInContext(Context);
204}
205
206/* llcontext -> int -> lltype */
207CAMLprim LLVMTypeRef llvm_integer_type(LLVMContextRef Context, value Width) {
208  return LLVMIntTypeInContext(Context, Int_val(Width));
209}
210
211/* lltype -> int */
212CAMLprim value llvm_integer_bitwidth(LLVMTypeRef IntegerTy) {
213  return Val_int(LLVMGetIntTypeWidth(IntegerTy));
214}
215
216/*--... Operations on real types ...........................................--*/
217
218/* llcontext -> lltype */
219CAMLprim LLVMTypeRef llvm_float_type(LLVMContextRef Context) {
220  return LLVMFloatTypeInContext(Context);
221}
222
223/* llcontext -> lltype */
224CAMLprim LLVMTypeRef llvm_double_type(LLVMContextRef Context) {
225  return LLVMDoubleTypeInContext(Context);
226}
227
228/* llcontext -> lltype */
229CAMLprim LLVMTypeRef llvm_x86fp80_type(LLVMContextRef Context) {
230  return LLVMX86FP80TypeInContext(Context);
231}
232
233/* llcontext -> lltype */
234CAMLprim LLVMTypeRef llvm_fp128_type(LLVMContextRef Context) {
235  return LLVMFP128TypeInContext(Context);
236}
237
238/* llcontext -> lltype */
239CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) {
240  return LLVMPPCFP128TypeInContext(Context);
241}
242
243/*--... Operations on function types .......................................--*/
244
245/* lltype -> lltype array -> lltype */
246CAMLprim LLVMTypeRef llvm_function_type(LLVMTypeRef RetTy, value ParamTys) {
247  return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
248                          Wosize_val(ParamTys), 0);
249}
250
251/* lltype -> lltype array -> lltype */
252CAMLprim LLVMTypeRef llvm_var_arg_function_type(LLVMTypeRef RetTy,
253                                                value ParamTys) {
254  return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
255                          Wosize_val(ParamTys), 1);
256}
257
258/* lltype -> bool */
259CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) {
260  return Val_bool(LLVMIsFunctionVarArg(FunTy));
261}
262
263/* lltype -> lltype array */
264CAMLprim value llvm_param_types(LLVMTypeRef FunTy) {
265  value Tys = alloc(LLVMCountParamTypes(FunTy), 0);
266  LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys);
267  return Tys;
268}
269
270/*--... Operations on struct types .........................................--*/
271
272/* llcontext -> lltype array -> lltype */
273CAMLprim LLVMTypeRef llvm_struct_type(LLVMContextRef C, value ElementTypes) {
274  return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
275                                 Wosize_val(ElementTypes), 0);
276}
277
278/* llcontext -> lltype array -> lltype */
279CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C,
280                                             value ElementTypes) {
281  return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
282                                 Wosize_val(ElementTypes), 1);
283}
284
285/* lltype -> lltype array */
286CAMLprim value llvm_element_types(LLVMTypeRef StructTy) {
287  value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
288  LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys);
289  return Tys;
290}
291
292/* lltype -> bool */
293CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) {
294  return Val_bool(LLVMIsPackedStruct(StructTy));
295}
296
297/*--... Operations on array, pointer, and vector types .....................--*/
298
299/* lltype -> int -> lltype */
300CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) {
301  return LLVMArrayType(ElementTy, Int_val(Count));
302}
303
304/* lltype -> lltype */
305CAMLprim LLVMTypeRef llvm_pointer_type(LLVMTypeRef ElementTy) {
306  return LLVMPointerType(ElementTy, 0);
307}
308
309/* lltype -> int -> lltype */
310CAMLprim LLVMTypeRef llvm_qualified_pointer_type(LLVMTypeRef ElementTy,
311                                                 value AddressSpace) {
312  return LLVMPointerType(ElementTy, Int_val(AddressSpace));
313}
314
315/* lltype -> int -> lltype */
316CAMLprim LLVMTypeRef llvm_vector_type(LLVMTypeRef ElementTy, value Count) {
317  return LLVMVectorType(ElementTy, Int_val(Count));
318}
319
320/* lltype -> int */
321CAMLprim value llvm_array_length(LLVMTypeRef ArrayTy) {
322  return Val_int(LLVMGetArrayLength(ArrayTy));
323}
324
325/* lltype -> int */
326CAMLprim value llvm_address_space(LLVMTypeRef PtrTy) {
327  return Val_int(LLVMGetPointerAddressSpace(PtrTy));
328}
329
330/* lltype -> int */
331CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) {
332  return Val_int(LLVMGetVectorSize(VectorTy));
333}
334
335/*--... Operations on other types ..........................................--*/
336
337/* llcontext -> lltype */
338CAMLprim LLVMTypeRef llvm_void_type (LLVMContextRef Context) {
339  return LLVMVoidTypeInContext(Context);
340}
341
342/* llcontext -> lltype */
343CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
344  return LLVMLabelTypeInContext(Context);
345}
346
347/* llcontext -> lltype */
348CAMLprim LLVMTypeRef llvm_opaque_type(LLVMContextRef Context) {
349  return LLVMOpaqueTypeInContext(Context);
350}
351
352/*--... Operations on type handles .........................................--*/
353
354#define Typehandle_val(v)  (*(LLVMTypeHandleRef *)(Data_custom_val(v)))
355
356static void llvm_finalize_handle(value TH) {
357  LLVMDisposeTypeHandle(Typehandle_val(TH));
358}
359
360static struct custom_operations typehandle_ops = {
361  (char *) "LLVMTypeHandle",
362  llvm_finalize_handle,
363  custom_compare_default,
364  custom_hash_default,
365  custom_serialize_default,
366  custom_deserialize_default
367};
368
369CAMLprim value llvm_handle_to_type(LLVMTypeRef PATy) {
370  value TH = alloc_custom(&typehandle_ops, sizeof(LLVMBuilderRef), 0, 1);
371  Typehandle_val(TH) = LLVMCreateTypeHandle(PATy);
372  return TH;
373}
374
375CAMLprim LLVMTypeRef llvm_type_of_handle(value TH) {
376  return LLVMResolveTypeHandle(Typehandle_val(TH));
377}
378
379CAMLprim value llvm_refine_type(LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy){
380  LLVMRefineType(AbstractTy, ConcreteTy);
381  return Val_unit;
382}
383
384
385/*===-- VALUES ------------------------------------------------------------===*/
386
387/* llvalue -> lltype */
388CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) {
389  return LLVMTypeOf(Val);
390}
391
392/* llvalue -> string */
393CAMLprim value llvm_value_name(LLVMValueRef Val) {
394  return copy_string(LLVMGetValueName(Val));
395}
396
397/* string -> llvalue -> unit */
398CAMLprim value llvm_set_value_name(value Name, LLVMValueRef Val) {
399  LLVMSetValueName(Val, String_val(Name));
400  return Val_unit;
401}
402
403/* llvalue -> unit */
404CAMLprim value llvm_dump_value(LLVMValueRef Val) {
405  LLVMDumpValue(Val);
406  return Val_unit;
407}
408
409/*--... Operations on constants of (mostly) any type .......................--*/
410
411/* llvalue -> bool */
412CAMLprim value llvm_is_constant(LLVMValueRef Val) {
413  return Val_bool(LLVMIsConstant(Val));
414}
415
416/* llvalue -> bool */
417CAMLprim value llvm_is_null(LLVMValueRef Val) {
418  return Val_bool(LLVMIsNull(Val));
419}
420
421/* llvalue -> bool */
422CAMLprim value llvm_is_undef(LLVMValueRef Val) {
423  return Val_bool(LLVMIsUndef(Val));
424}
425
426/*--... Operations on scalar constants .....................................--*/
427
428/* lltype -> int -> llvalue */
429CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) {
430  return LLVMConstInt(IntTy, (long long) Int_val(N), 1);
431}
432
433/* lltype -> Int64.t -> bool -> llvalue */
434CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
435                                          value SExt) {
436  return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
437}
438
439/* lltype -> string -> int -> llvalue */
440CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
441                                               value Radix) {
442  return LLVMConstIntOfStringAndSize(IntTy, String_val(S), caml_string_length(S),
443                                     Int_val(Radix));
444}
445
446/* lltype -> float -> llvalue */
447CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) {
448  return LLVMConstReal(RealTy, Double_val(N));
449}
450
451/* lltype -> string -> llvalue */
452CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) {
453  return LLVMConstRealOfStringAndSize(RealTy, String_val(S),
454                                      caml_string_length(S));
455}
456
457/*--... Operations on composite constants ..................................--*/
458
459/* llcontext -> string -> llvalue */
460CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str,
461                                        value NullTerminate) {
462  return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
463                                  1);
464}
465
466/* llcontext -> string -> llvalue */
467CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str,
468                                         value NullTerminate) {
469  return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
470                                  0);
471}
472
473/* lltype -> llvalue array -> llvalue */
474CAMLprim LLVMValueRef llvm_const_array(LLVMTypeRef ElementTy,
475                                               value ElementVals) {
476  return LLVMConstArray(ElementTy, (LLVMValueRef*) Op_val(ElementVals),
477                        Wosize_val(ElementVals));
478}
479
480/* llcontext -> llvalue array -> llvalue */
481CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) {
482  return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
483                                  Wosize_val(ElementVals), 0);
484}
485
486/* llcontext -> llvalue array -> llvalue */
487CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C,
488                                               value ElementVals) {
489  return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
490                                  Wosize_val(ElementVals), 1);
491}
492
493/* llvalue array -> llvalue */
494CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
495  return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals),
496                         Wosize_val(ElementVals));
497}
498
499/*--... Constant expressions ...............................................--*/
500
501/* Icmp.t -> llvalue -> llvalue -> llvalue */
502CAMLprim LLVMValueRef llvm_const_icmp(value Pred,
503                                      LLVMValueRef LHSConstant,
504                                      LLVMValueRef RHSConstant) {
505  return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant);
506}
507
508/* Fcmp.t -> llvalue -> llvalue -> llvalue */
509CAMLprim LLVMValueRef llvm_const_fcmp(value Pred,
510                                      LLVMValueRef LHSConstant,
511                                      LLVMValueRef RHSConstant) {
512  return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant);
513}
514
515/* llvalue -> llvalue array -> llvalue */
516CAMLprim LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) {
517  return LLVMConstGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
518                      Wosize_val(Indices));
519}
520
521/* llvalue -> llvalue array -> llvalue */
522CAMLprim LLVMValueRef llvm_const_in_bounds_gep(LLVMValueRef ConstantVal,
523                                               value Indices) {
524  return LLVMConstInBoundsGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
525                              Wosize_val(Indices));
526}
527
528/* llvalue -> int array -> llvalue */
529CAMLprim LLVMValueRef llvm_const_extractvalue(LLVMValueRef Aggregate,
530                                              value Indices) {
531  CAMLparam1(Indices);
532  int size = Wosize_val(Indices);
533  int i;
534  LLVMValueRef result;
535
536  unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
537  for (i = 0; i < size; i++) {
538    idxs[i] = Int_val(Field(Indices, i));
539  }
540
541  result = LLVMConstExtractValue(Aggregate, idxs, size);
542  free(idxs);
543  CAMLreturnT(LLVMValueRef, result);
544}
545
546/* llvalue -> llvalue -> int array -> llvalue */
547CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate,
548                                             LLVMValueRef Val, value Indices) {
549  CAMLparam1(Indices);
550  int size = Wosize_val(Indices);
551  int i;
552  LLVMValueRef result;
553
554  unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
555  for (i = 0; i < size; i++) {
556    idxs[i] = Int_val(Field(Indices, i));
557  }
558
559  result = LLVMConstInsertValue(Aggregate, Val, idxs, size);
560  free(idxs);
561  CAMLreturnT(LLVMValueRef, result);
562}
563
564/*--... Operations on global variables, functions, and aliases (globals) ...--*/
565
566/* llvalue -> bool */
567CAMLprim value llvm_is_declaration(LLVMValueRef Global) {
568  return Val_bool(LLVMIsDeclaration(Global));
569}
570
571/* llvalue -> Linkage.t */
572CAMLprim value llvm_linkage(LLVMValueRef Global) {
573  return Val_int(LLVMGetLinkage(Global));
574}
575
576/* Linkage.t -> llvalue -> unit */
577CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) {
578  LLVMSetLinkage(Global, Int_val(Linkage));
579  return Val_unit;
580}
581
582/* llvalue -> string */
583CAMLprim value llvm_section(LLVMValueRef Global) {
584  return copy_string(LLVMGetSection(Global));
585}
586
587/* string -> llvalue -> unit */
588CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) {
589  LLVMSetSection(Global, String_val(Section));
590  return Val_unit;
591}
592
593/* llvalue -> Visibility.t */
594CAMLprim value llvm_visibility(LLVMValueRef Global) {
595  return Val_int(LLVMGetVisibility(Global));
596}
597
598/* Visibility.t -> llvalue -> unit */
599CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) {
600  LLVMSetVisibility(Global, Int_val(Viz));
601  return Val_unit;
602}
603
604/* llvalue -> int */
605CAMLprim value llvm_alignment(LLVMValueRef Global) {
606  return Val_int(LLVMGetAlignment(Global));
607}
608
609/* int -> llvalue -> unit */
610CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
611  LLVMSetAlignment(Global, Int_val(Bytes));
612  return Val_unit;
613}
614
615/*--... Operations on global variables .....................................--*/
616
617DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef,
618                 LLVMGetGlobalParent)
619
620/* lltype -> string -> llmodule -> llvalue */
621CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
622                                          LLVMModuleRef M) {
623  LLVMValueRef GlobalVar;
624  if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
625    if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
626      return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty, 0));
627    return GlobalVar;
628  }
629  return LLVMAddGlobal(M, Ty, String_val(Name));
630}
631
632/* string -> llmodule -> llvalue option */
633CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
634  CAMLparam1(Name);
635  LLVMValueRef GlobalVar;
636  if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
637    value Option = alloc(1, 0);
638    Field(Option, 0) = (value) GlobalVar;
639    CAMLreturn(Option);
640  }
641  CAMLreturn(Val_int(0));
642}
643
644/* string -> llvalue -> llmodule -> llvalue */
645CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
646                                         LLVMModuleRef M) {
647  LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer),
648                                         String_val(Name));
649  LLVMSetInitializer(GlobalVar, Initializer);
650  return GlobalVar;
651}
652
653/* llvalue -> unit */
654CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) {
655  LLVMDeleteGlobal(GlobalVar);
656  return Val_unit;
657}
658
659/* llvalue -> llvalue -> unit */
660CAMLprim value llvm_set_initializer(LLVMValueRef ConstantVal,
661                                    LLVMValueRef GlobalVar) {
662  LLVMSetInitializer(GlobalVar, ConstantVal);
663  return Val_unit;
664}
665
666/* llvalue -> unit */
667CAMLprim value llvm_remove_initializer(LLVMValueRef GlobalVar) {
668  LLVMSetInitializer(GlobalVar, NULL);
669  return Val_unit;
670}
671
672/* llvalue -> bool */
673CAMLprim value llvm_is_thread_local(LLVMValueRef GlobalVar) {
674  return Val_bool(LLVMIsThreadLocal(GlobalVar));
675}
676
677/* bool -> llvalue -> unit */
678CAMLprim value llvm_set_thread_local(value IsThreadLocal,
679                                     LLVMValueRef GlobalVar) {
680  LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal));
681  return Val_unit;
682}
683
684/* llvalue -> bool */
685CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) {
686  return Val_bool(LLVMIsGlobalConstant(GlobalVar));
687}
688
689/* bool -> llvalue -> unit */
690CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
691  LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag));
692  return Val_unit;
693}
694
695/*--... Operations on functions ............................................--*/
696
697DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef,
698                 LLVMGetGlobalParent)
699
700/* string -> lltype -> llmodule -> llvalue */
701CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
702                                            LLVMModuleRef M) {
703  LLVMValueRef Fn;
704  if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
705    if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
706      return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0));
707    return Fn;
708  }
709  return LLVMAddFunction(M, String_val(Name), Ty);
710}
711
712/* string -> llmodule -> llvalue option */
713CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
714  CAMLparam1(Name);
715  LLVMValueRef Fn;
716  if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
717    value Option = alloc(1, 0);
718    Field(Option, 0) = (value) Fn;
719    CAMLreturn(Option);
720  }
721  CAMLreturn(Val_int(0));
722}
723
724/* string -> lltype -> llmodule -> llvalue */
725CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
726                                           LLVMModuleRef M) {
727  LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
728  LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry");
729  return Fn;
730}
731
732/* llvalue -> unit */
733CAMLprim value llvm_delete_function(LLVMValueRef Fn) {
734  LLVMDeleteFunction(Fn);
735  return Val_unit;
736}
737
738/* llvalue -> bool */
739CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) {
740  return Val_bool(LLVMGetIntrinsicID(Fn));
741}
742
743/* llvalue -> int */
744CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) {
745  return Val_int(LLVMGetFunctionCallConv(Fn));
746}
747
748/* int -> llvalue -> unit */
749CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) {
750  LLVMSetFunctionCallConv(Fn, Int_val(Id));
751  return Val_unit;
752}
753
754/* llvalue -> string option */
755CAMLprim value llvm_gc(LLVMValueRef Fn) {
756  const char *GC;
757  CAMLparam0();
758  CAMLlocal2(Name, Option);
759
760  if ((GC = LLVMGetGC(Fn))) {
761    Name = copy_string(GC);
762
763    Option = alloc(1, 0);
764    Field(Option, 0) = Name;
765    CAMLreturn(Option);
766  } else {
767    CAMLreturn(Val_int(0));
768  }
769}
770
771/* string option -> llvalue -> unit */
772CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
773  LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0)));
774  return Val_unit;
775}
776
777/* llvalue -> Attribute.t -> unit */
778CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
779  LLVMAddFunctionAttr(Arg, 1<<Int_val(PA));
780  return Val_unit;
781}
782
783/* llvalue -> Attribute.t -> unit */
784CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
785  LLVMRemoveFunctionAttr(Arg, 1<<Int_val(PA));
786  return Val_unit;
787}
788/*--... Operations on parameters ...........................................--*/
789
790DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
791
792/* llvalue -> int -> llvalue */
793CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
794  return LLVMGetParam(Fn, Int_val(Index));
795}
796
797/* llvalue -> int -> llvalue */
798CAMLprim value llvm_params(LLVMValueRef Fn, value Index) {
799  value Params = alloc(LLVMCountParams(Fn), 0);
800  LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
801  return Params;
802}
803
804/* llvalue -> Attribute.t -> unit */
805CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
806  LLVMAddAttribute(Arg, 1<<Int_val(PA));
807  return Val_unit;
808}
809
810/* llvalue -> Attribute.t -> unit */
811CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
812  LLVMRemoveAttribute(Arg, 1<<Int_val(PA));
813  return Val_unit;
814}
815
816/* llvalue -> int -> unit */
817CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
818  LLVMSetParamAlignment(Arg, Int_val(align));
819  return Val_unit;
820}
821
822/*--... Operations on basic blocks .........................................--*/
823
824DEFINE_ITERATORS(
825  block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
826
827/* llvalue -> llbasicblock array */
828CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
829  value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
830  LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
831  return MLArray;
832}
833
834/* llbasicblock -> unit */
835CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
836  LLVMDeleteBasicBlock(BB);
837  return Val_unit;
838}
839
840/* string -> llvalue -> llbasicblock */
841CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
842                                             LLVMValueRef Fn) {
843  return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name));
844}
845
846/* string -> llbasicblock -> llbasicblock */
847CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name,
848                                             LLVMBasicBlockRef BB) {
849  return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name));
850}
851
852/* llvalue -> bool */
853CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
854  return Val_bool(LLVMValueIsBasicBlock(Val));
855}
856
857/*--... Operations on instructions .........................................--*/
858
859DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
860                 LLVMGetInstructionParent)
861
862
863/*--... Operations on call sites ...........................................--*/
864
865/* llvalue -> int */
866CAMLprim value llvm_instruction_call_conv(LLVMValueRef Inst) {
867  return Val_int(LLVMGetInstructionCallConv(Inst));
868}
869
870/* int -> llvalue -> unit */
871CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
872  LLVMSetInstructionCallConv(Inst, Int_val(CC));
873  return Val_unit;
874}
875
876/* llvalue -> int -> Attribute.t -> unit */
877CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
878                                               value index,
879                                               value PA) {
880  LLVMAddInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
881  return Val_unit;
882}
883
884/* llvalue -> int -> Attribute.t -> unit */
885CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
886                                                  value index,
887                                                  value PA) {
888  LLVMRemoveInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
889  return Val_unit;
890}
891
892/*--... Operations on call instructions (only) .............................--*/
893
894/* llvalue -> bool */
895CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) {
896  return Val_bool(LLVMIsTailCall(CallInst));
897}
898
899/* bool -> llvalue -> unit */
900CAMLprim value llvm_set_tail_call(value IsTailCall,
901                                  LLVMValueRef CallInst) {
902  LLVMSetTailCall(CallInst, Bool_val(IsTailCall));
903  return Val_unit;
904}
905
906/*--... Operations on phi nodes ............................................--*/
907
908/* (llvalue * llbasicblock) -> llvalue -> unit */
909CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
910  LLVMAddIncoming(PhiNode,
911                  (LLVMValueRef*) &Field(Incoming, 0),
912                  (LLVMBasicBlockRef*) &Field(Incoming, 1),
913                  1);
914  return Val_unit;
915}
916
917/* llvalue -> (llvalue * llbasicblock) list */
918CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
919  unsigned I;
920  CAMLparam0();
921  CAMLlocal3(Hd, Tl, Tmp);
922
923  /* Build a tuple list of them. */
924  Tl = Val_int(0);
925  for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
926    Hd = alloc(2, 0);
927    Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
928    Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
929
930    Tmp = alloc(2, 0);
931    Store_field(Tmp, 0, Hd);
932    Store_field(Tmp, 1, Tl);
933    Tl = Tmp;
934  }
935
936  CAMLreturn(Tl);
937}
938
939
940/*===-- Instruction builders ----------------------------------------------===*/
941
942#define Builder_val(v)  (*(LLVMBuilderRef *)(Data_custom_val(v)))
943
944static void llvm_finalize_builder(value B) {
945  LLVMDisposeBuilder(Builder_val(B));
946}
947
948static struct custom_operations builder_ops = {
949  (char *) "IRBuilder",
950  llvm_finalize_builder,
951  custom_compare_default,
952  custom_hash_default,
953  custom_serialize_default,
954  custom_deserialize_default
955};
956
957static value alloc_builder(LLVMBuilderRef B) {
958  value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
959  Builder_val(V) = B;
960  return V;
961}
962
963/* llcontext -> llbuilder */
964CAMLprim value llvm_builder(LLVMContextRef C) {
965  return alloc_builder(LLVMCreateBuilderInContext(C));
966}
967
968/* (llbasicblock, llvalue) llpos -> llbuilder -> unit */
969CAMLprim value llvm_position_builder(value Pos, value B) {
970  if (Tag_val(Pos) == 0) {
971    LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0));
972    LLVMPositionBuilderAtEnd(Builder_val(B), BB);
973  } else {
974    LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0));
975    LLVMPositionBuilderBefore(Builder_val(B), I);
976  }
977  return Val_unit;
978}
979
980/* llbuilder -> llbasicblock */
981CAMLprim LLVMBasicBlockRef llvm_insertion_block(LLVMBuilderRef B) {
982  LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
983  if (!InsertBlock)
984    raise_not_found();
985  return InsertBlock;
986}
987
988/* llvalue -> string -> llbuilder -> unit */
989CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name,
990                                               LLVMBuilderRef B) {
991  LLVMInsertIntoBuilderWithName(B, I, String_val(Name));
992  return Val_unit;
993}
994
995/*--... Terminators ........................................................--*/
996
997/* llbuilder -> llvalue */
998CAMLprim LLVMValueRef llvm_build_ret_void(value B) {
999  return LLVMBuildRetVoid(Builder_val(B));
1000}
1001
1002/* llvalue -> llbuilder -> llvalue */
1003CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) {
1004  return LLVMBuildRet(Builder_val(B), Val);
1005}
1006
1007/* llvalue array -> llbuilder -> llvalue */
1008CAMLprim LLVMValueRef llvm_build_aggregate_ret(value RetVals, value B) {
1009  return LLVMBuildAggregateRet(Builder_val(B), (LLVMValueRef *) Op_val(RetVals),
1010                               Wosize_val(RetVals));
1011}
1012
1013/* llbasicblock -> llbuilder -> llvalue */
1014CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) {
1015  return LLVMBuildBr(Builder_val(B), BB);
1016}
1017
1018/* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */
1019CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If,
1020                                         LLVMBasicBlockRef Then,
1021                                         LLVMBasicBlockRef Else,
1022                                         value B) {
1023  return LLVMBuildCondBr(Builder_val(B), If, Then, Else);
1024}
1025
1026/* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */
1027CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
1028                                        LLVMBasicBlockRef Else,
1029                                        value EstimatedCount,
1030                                        value B) {
1031  return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
1032}
1033
1034CAMLprim value llvm_add_case(LLVMValueRef Switch,
1035                             LLVMValueRef OnVal,
1036                             LLVMBasicBlockRef Dest) {
1037  LLVMAddCase(Switch, OnVal, Dest);
1038  return Val_unit;
1039}
1040
1041/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1042   llbuilder -> llvalue */
1043CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
1044                                            LLVMBasicBlockRef Then,
1045                                            LLVMBasicBlockRef Catch,
1046                                            value Name, value B) {
1047  return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Args),
1048                         Wosize_val(Args), Then, Catch, String_val(Name));
1049}
1050
1051/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1052   llbuilder -> llvalue */
1053CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
1054  return llvm_build_invoke_nat((LLVMValueRef) Args[0], Args[1],
1055                               (LLVMBasicBlockRef) Args[2],
1056                               (LLVMBasicBlockRef) Args[3],
1057                               Args[4], Args[5]);
1058}
1059
1060/* llbuilder -> llvalue */
1061CAMLprim LLVMValueRef llvm_build_unwind(value B) {
1062  return LLVMBuildUnwind(Builder_val(B));
1063}
1064
1065/* llbuilder -> llvalue */
1066CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
1067  return LLVMBuildUnreachable(Builder_val(B));
1068}
1069
1070/*--... Arithmetic .........................................................--*/
1071
1072/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1073CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS,
1074                                     value Name, value B) {
1075  return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name));
1076}
1077
1078/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1079CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1080                                         value Name, value B) {
1081  return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1082}
1083
1084/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1085CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS,
1086                                      value Name, value B) {
1087  return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name));
1088}
1089
1090/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1091CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1092                                     value Name, value B) {
1093  return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name));
1094}
1095
1096/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1097CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS,
1098                                      value Name, value B) {
1099  return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name));
1100}
1101
1102/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1103CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1104                                     value Name, value B) {
1105  return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name));
1106}
1107
1108/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1109CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS,
1110                                      value Name, value B) {
1111  return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name));
1112}
1113
1114/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1115CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS,
1116                                      value Name, value B) {
1117  return LLVMBuildUDiv(Builder_val(B), LHS, RHS, String_val(Name));
1118}
1119
1120/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1121CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1122                                      value Name, value B) {
1123  return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1124}
1125
1126/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1127CAMLprim LLVMValueRef llvm_build_exact_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1128                                            value Name, value B) {
1129  return LLVMBuildExactSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1130}
1131
1132/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1133CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1134                                      value Name, value B) {
1135  return LLVMBuildFDiv(Builder_val(B), LHS, RHS, String_val(Name));
1136}
1137
1138/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1139CAMLprim LLVMValueRef llvm_build_urem(LLVMValueRef LHS, LLVMValueRef RHS,
1140                                      value Name, value B) {
1141  return LLVMBuildURem(Builder_val(B), LHS, RHS, String_val(Name));
1142}
1143
1144/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1145CAMLprim LLVMValueRef llvm_build_srem(LLVMValueRef LHS, LLVMValueRef RHS,
1146                                      value Name, value B) {
1147  return LLVMBuildSRem(Builder_val(B), LHS, RHS, String_val(Name));
1148}
1149
1150/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1151CAMLprim LLVMValueRef llvm_build_frem(LLVMValueRef LHS, LLVMValueRef RHS,
1152                                      value Name, value B) {
1153  return LLVMBuildFRem(Builder_val(B), LHS, RHS, String_val(Name));
1154}
1155
1156/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1157CAMLprim LLVMValueRef llvm_build_shl(LLVMValueRef LHS, LLVMValueRef RHS,
1158                                     value Name, value B) {
1159  return LLVMBuildShl(Builder_val(B), LHS, RHS, String_val(Name));
1160}
1161
1162/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1163CAMLprim LLVMValueRef llvm_build_lshr(LLVMValueRef LHS, LLVMValueRef RHS,
1164                                      value Name, value B) {
1165  return LLVMBuildLShr(Builder_val(B), LHS, RHS, String_val(Name));
1166}
1167
1168/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1169CAMLprim LLVMValueRef llvm_build_ashr(LLVMValueRef LHS, LLVMValueRef RHS,
1170                                      value Name, value B) {
1171  return LLVMBuildAShr(Builder_val(B), LHS, RHS, String_val(Name));
1172}
1173
1174/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1175CAMLprim LLVMValueRef llvm_build_and(LLVMValueRef LHS, LLVMValueRef RHS,
1176                                     value Name, value B) {
1177  return LLVMBuildAnd(Builder_val(B), LHS, RHS, String_val(Name));
1178}
1179
1180/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1181CAMLprim LLVMValueRef llvm_build_or(LLVMValueRef LHS, LLVMValueRef RHS,
1182                                    value Name, value B) {
1183  return LLVMBuildOr(Builder_val(B), LHS, RHS, String_val(Name));
1184}
1185
1186/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1187CAMLprim LLVMValueRef llvm_build_xor(LLVMValueRef LHS, LLVMValueRef RHS,
1188                                     value Name, value B) {
1189  return LLVMBuildXor(Builder_val(B), LHS, RHS, String_val(Name));
1190}
1191
1192/* llvalue -> string -> llbuilder -> llvalue */
1193CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X,
1194                                     value Name, value B) {
1195  return LLVMBuildNeg(Builder_val(B), X, String_val(Name));
1196}
1197
1198/* llvalue -> string -> llbuilder -> llvalue */
1199CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X,
1200                                     value Name, value B) {
1201  return LLVMBuildNot(Builder_val(B), X, String_val(Name));
1202}
1203
1204/*--... Memory .............................................................--*/
1205
1206/* lltype -> string -> llbuilder -> llvalue */
1207CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty,
1208                                        value Name, value B) {
1209  return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
1210}
1211
1212/* lltype -> llvalue -> string -> llbuilder -> llvalue */
1213CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty, LLVMValueRef Size,
1214                                              value Name, value B) {
1215  return LLVMBuildArrayMalloc(Builder_val(B), Ty, Size, String_val(Name));
1216}
1217
1218/* lltype -> string -> llbuilder -> llvalue */
1219CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty,
1220                                        value Name, value B) {
1221  return LLVMBuildAlloca(Builder_val(B), Ty, String_val(Name));
1222}
1223
1224/* lltype -> llvalue -> string -> llbuilder -> llvalue */
1225CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size,
1226                                              value Name, value B) {
1227  return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name));
1228}
1229
1230/* llvalue -> llbuilder -> llvalue */
1231CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef Pointer, value B) {
1232  return LLVMBuildFree(Builder_val(B), Pointer);
1233}
1234
1235/* llvalue -> string -> llbuilder -> llvalue */
1236CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer,
1237                                      value Name, value B) {
1238  return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name));
1239}
1240
1241/* llvalue -> llvalue -> llbuilder -> llvalue */
1242CAMLprim LLVMValueRef llvm_build_store(LLVMValueRef Value, LLVMValueRef Pointer,
1243                                       value B) {
1244  return LLVMBuildStore(Builder_val(B), Value, Pointer);
1245}
1246
1247/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1248CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices,
1249                                     value Name, value B) {
1250  return LLVMBuildGEP(Builder_val(B), Pointer,
1251                      (LLVMValueRef *) Op_val(Indices), Wosize_val(Indices),
1252                      String_val(Name));
1253}
1254
1255/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1256CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer,
1257                                               value Indices, value Name,
1258                                               value B) {
1259  return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
1260                              (LLVMValueRef *) Op_val(Indices),
1261                              Wosize_val(Indices), String_val(Name));
1262}
1263
1264/* llvalue -> int -> string -> llbuilder -> llvalue */
1265CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer,
1266                                               value Index, value Name,
1267                                               value B) {
1268  return LLVMBuildStructGEP(Builder_val(B), Pointer,
1269                              Int_val(Index), String_val(Name));
1270}
1271
1272/* string -> string -> llbuilder -> llvalue */
1273CAMLprim LLVMValueRef llvm_build_global_string(value Str, value Name, value B) {
1274  return LLVMBuildGlobalString(Builder_val(B), String_val(Str),
1275                               String_val(Name));
1276}
1277
1278/* string -> string -> llbuilder -> llvalue */
1279CAMLprim LLVMValueRef llvm_build_global_stringptr(value Str, value Name,
1280                                                  value B) {
1281  return LLVMBuildGlobalStringPtr(Builder_val(B), String_val(Str),
1282                                  String_val(Name));
1283}
1284
1285/*--... Casts ..............................................................--*/
1286
1287/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1288CAMLprim LLVMValueRef llvm_build_trunc(LLVMValueRef X, LLVMTypeRef Ty,
1289                                       value Name, value B) {
1290  return LLVMBuildTrunc(Builder_val(B), X, Ty, String_val(Name));
1291}
1292
1293/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1294CAMLprim LLVMValueRef llvm_build_zext(LLVMValueRef X, LLVMTypeRef Ty,
1295                                      value Name, value B) {
1296  return LLVMBuildZExt(Builder_val(B), X, Ty, String_val(Name));
1297}
1298
1299/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1300CAMLprim LLVMValueRef llvm_build_sext(LLVMValueRef X, LLVMTypeRef Ty,
1301                                      value Name, value B) {
1302  return LLVMBuildSExt(Builder_val(B), X, Ty, String_val(Name));
1303}
1304
1305/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1306CAMLprim LLVMValueRef llvm_build_fptoui(LLVMValueRef X, LLVMTypeRef Ty,
1307                                        value Name, value B) {
1308  return LLVMBuildFPToUI(Builder_val(B), X, Ty, String_val(Name));
1309}
1310
1311/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1312CAMLprim LLVMValueRef llvm_build_fptosi(LLVMValueRef X, LLVMTypeRef Ty,
1313                                        value Name, value B) {
1314  return LLVMBuildFPToSI(Builder_val(B), X, Ty, String_val(Name));
1315}
1316
1317/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1318CAMLprim LLVMValueRef llvm_build_uitofp(LLVMValueRef X, LLVMTypeRef Ty,
1319                                        value Name, value B) {
1320  return LLVMBuildUIToFP(Builder_val(B), X, Ty, String_val(Name));
1321}
1322
1323/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1324CAMLprim LLVMValueRef llvm_build_sitofp(LLVMValueRef X, LLVMTypeRef Ty,
1325                                        value Name, value B) {
1326  return LLVMBuildSIToFP(Builder_val(B), X, Ty, String_val(Name));
1327}
1328
1329/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1330CAMLprim LLVMValueRef llvm_build_fptrunc(LLVMValueRef X, LLVMTypeRef Ty,
1331                                         value Name, value B) {
1332  return LLVMBuildFPTrunc(Builder_val(B), X, Ty, String_val(Name));
1333}
1334
1335/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1336CAMLprim LLVMValueRef llvm_build_fpext(LLVMValueRef X, LLVMTypeRef Ty,
1337                                       value Name, value B) {
1338  return LLVMBuildFPExt(Builder_val(B), X, Ty, String_val(Name));
1339}
1340
1341/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1342CAMLprim LLVMValueRef llvm_build_prttoint(LLVMValueRef X, LLVMTypeRef Ty,
1343                                          value Name, value B) {
1344  return LLVMBuildPtrToInt(Builder_val(B), X, Ty, String_val(Name));
1345}
1346
1347/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1348CAMLprim LLVMValueRef llvm_build_inttoptr(LLVMValueRef X, LLVMTypeRef Ty,
1349                                          value Name, value B) {
1350  return LLVMBuildIntToPtr(Builder_val(B), X, Ty, String_val(Name));
1351}
1352
1353/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1354CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1355                                         value Name, value B) {
1356  return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name));
1357}
1358
1359/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1360CAMLprim LLVMValueRef llvm_build_zext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1361                                                 value Name, value B) {
1362  return LLVMBuildZExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1363}
1364
1365/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1366CAMLprim LLVMValueRef llvm_build_sext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1367                                                 value Name, value B) {
1368  return LLVMBuildSExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1369}
1370
1371/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1372CAMLprim LLVMValueRef llvm_build_trunc_or_bitcast(LLVMValueRef X,
1373                                                  LLVMTypeRef Ty, value Name,
1374                                                  value B) {
1375  return LLVMBuildTruncOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1376}
1377
1378/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1379CAMLprim LLVMValueRef llvm_build_pointercast(LLVMValueRef X, LLVMTypeRef Ty,
1380                                             value Name, value B) {
1381  return LLVMBuildPointerCast(Builder_val(B), X, Ty, String_val(Name));
1382}
1383
1384/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1385CAMLprim LLVMValueRef llvm_build_intcast(LLVMValueRef X, LLVMTypeRef Ty,
1386                                         value Name, value B) {
1387  return LLVMBuildIntCast(Builder_val(B), X, Ty, String_val(Name));
1388}
1389
1390/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1391CAMLprim LLVMValueRef llvm_build_fpcast(LLVMValueRef X, LLVMTypeRef Ty,
1392                                        value Name, value B) {
1393  return LLVMBuildFPCast(Builder_val(B), X, Ty, String_val(Name));
1394}
1395
1396/*--... Comparisons ........................................................--*/
1397
1398/* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1399CAMLprim LLVMValueRef llvm_build_icmp(value Pred,
1400                                      LLVMValueRef LHS, LLVMValueRef RHS,
1401                                      value Name, value B) {
1402  return LLVMBuildICmp(Builder_val(B), Int_val(Pred) + LLVMIntEQ, LHS, RHS,
1403                       String_val(Name));
1404}
1405
1406/* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1407CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
1408                                      LLVMValueRef LHS, LLVMValueRef RHS,
1409                                      value Name, value B) {
1410  return LLVMBuildFCmp(Builder_val(B), Int_val(Pred), LHS, RHS,
1411                       String_val(Name));
1412}
1413
1414/*--... Miscellaneous instructions .........................................--*/
1415
1416/* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */
1417CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
1418  value Hd, Tl;
1419  LLVMValueRef FirstValue, PhiNode;
1420
1421  assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
1422
1423  Hd = Field(Incoming, 0);
1424  FirstValue = (LLVMValueRef) Field(Hd, 0);
1425  PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
1426                         String_val(Name));
1427
1428  for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) {
1429    value Hd = Field(Tl, 0);
1430    LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
1431                    (LLVMBasicBlockRef*) &Field(Hd, 1), 1);
1432  }
1433
1434  return PhiNode;
1435}
1436
1437/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1438CAMLprim LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params,
1439                                      value Name, value B) {
1440  return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Params),
1441                       Wosize_val(Params), String_val(Name));
1442}
1443
1444/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1445CAMLprim LLVMValueRef llvm_build_select(LLVMValueRef If,
1446                                        LLVMValueRef Then, LLVMValueRef Else,
1447                                        value Name, value B) {
1448  return LLVMBuildSelect(Builder_val(B), If, Then, Else, String_val(Name));
1449}
1450
1451/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1452CAMLprim LLVMValueRef llvm_build_va_arg(LLVMValueRef List, LLVMTypeRef Ty,
1453                                        value Name, value B) {
1454  return LLVMBuildVAArg(Builder_val(B), List, Ty, String_val(Name));
1455}
1456
1457/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1458CAMLprim LLVMValueRef llvm_build_extractelement(LLVMValueRef Vec,
1459                                                LLVMValueRef Idx,
1460                                                value Name, value B) {
1461  return LLVMBuildExtractElement(Builder_val(B), Vec, Idx, String_val(Name));
1462}
1463
1464/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1465CAMLprim LLVMValueRef llvm_build_insertelement(LLVMValueRef Vec,
1466                                               LLVMValueRef Element,
1467                                               LLVMValueRef Idx,
1468                                               value Name, value B) {
1469  return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx,
1470                                String_val(Name));
1471}
1472
1473/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1474CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2,
1475                                               LLVMValueRef Mask,
1476                                               value Name, value B) {
1477  return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name));
1478}
1479
1480/* llvalue -> int -> string -> llbuilder -> llvalue */
1481CAMLprim LLVMValueRef llvm_build_extractvalue(LLVMValueRef Aggregate,
1482                                              value Idx, value Name, value B) {
1483  return LLVMBuildExtractValue(Builder_val(B), Aggregate, Int_val(Idx),
1484                               String_val(Name));
1485}
1486
1487/* llvalue -> llvalue -> int -> string -> llbuilder -> llvalue */
1488CAMLprim LLVMValueRef llvm_build_insertvalue(LLVMValueRef Aggregate,
1489                                             LLVMValueRef Val, value Idx,
1490                                             value Name, value B) {
1491  return LLVMBuildInsertValue(Builder_val(B), Aggregate, Val, Int_val(Idx),
1492                              String_val(Name));
1493}
1494
1495/* llvalue -> string -> llbuilder -> llvalue */
1496CAMLprim LLVMValueRef llvm_build_is_null(LLVMValueRef Val, value Name,
1497                                         value B) {
1498  return LLVMBuildIsNull(Builder_val(B), Val, String_val(Name));
1499}
1500
1501/* llvalue -> string -> llbuilder -> llvalue */
1502CAMLprim LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name,
1503                                             value B) {
1504  return LLVMBuildIsNotNull(Builder_val(B), Val, String_val(Name));
1505}
1506
1507/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1508CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS,
1509                                         value Name, value B) {
1510  return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name));
1511}
1512
1513/*===-- Module Providers --------------------------------------------------===*/
1514
1515/* llmoduleprovider -> unit */
1516CAMLprim value llvm_dispose_module_provider(LLVMModuleProviderRef MP) {
1517  LLVMDisposeModuleProvider(MP);
1518  return Val_unit;
1519}
1520
1521
1522/*===-- Memory buffers ----------------------------------------------------===*/
1523
1524/* string -> llmemorybuffer
1525   raises IoError msg on error */
1526CAMLprim value llvm_memorybuffer_of_file(value Path) {
1527  CAMLparam1(Path);
1528  char *Message;
1529  LLVMMemoryBufferRef MemBuf;
1530
1531  if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path),
1532                                               &MemBuf, &Message))
1533    llvm_raise(llvm_ioerror_exn, Message);
1534
1535  CAMLreturn((value) MemBuf);
1536}
1537
1538/* unit -> llmemorybuffer
1539   raises IoError msg on error */
1540CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
1541  char *Message;
1542  LLVMMemoryBufferRef MemBuf;
1543
1544  if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message))
1545    llvm_raise(llvm_ioerror_exn, Message);
1546
1547  return MemBuf;
1548}
1549
1550/* llmemorybuffer -> unit */
1551CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) {
1552  LLVMDisposeMemoryBuffer(MemBuf);
1553  return Val_unit;
1554}
1555
1556/*===-- Pass Managers -----------------------------------------------------===*/
1557
1558/* unit -> [ `Module ] PassManager.t */
1559CAMLprim LLVMPassManagerRef llvm_passmanager_create(value Unit) {
1560  return LLVMCreatePassManager();
1561}
1562
1563/* llmodule -> [ `Function ] PassManager.t -> bool */
1564CAMLprim value llvm_passmanager_run_module(LLVMModuleRef M,
1565                                           LLVMPassManagerRef PM) {
1566  return Val_bool(LLVMRunPassManager(PM, M));
1567}
1568
1569/* [ `Function ] PassManager.t -> bool */
1570CAMLprim value llvm_passmanager_initialize(LLVMPassManagerRef FPM) {
1571  return Val_bool(LLVMInitializeFunctionPassManager(FPM));
1572}
1573
1574/* llvalue -> [ `Function ] PassManager.t -> bool */
1575CAMLprim value llvm_passmanager_run_function(LLVMValueRef F,
1576                                             LLVMPassManagerRef FPM) {
1577  return Val_bool(LLVMRunFunctionPassManager(FPM, F));
1578}
1579
1580/* [ `Function ] PassManager.t -> bool */
1581CAMLprim value llvm_passmanager_finalize(LLVMPassManagerRef FPM) {
1582  return Val_bool(LLVMFinalizeFunctionPassManager(FPM));
1583}
1584
1585/* PassManager.any PassManager.t -> unit */
1586CAMLprim value llvm_passmanager_dispose(LLVMPassManagerRef PM) {
1587  LLVMDisposePassManager(PM);
1588  return Val_unit;
1589}
1590