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