[OCaml] Implement missing LLVMCore APIs
[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 CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value Name)
639 {
640   CAMLparam1(Name);
641   CAMLlocal1(Nodes);
642   Nodes = alloc(LLVMGetNamedMetadataNumOperands(M, String_val(Name)), 0);
643   LLVMGetNamedMetadataOperands(M, String_val(Name), (LLVMValueRef *) Nodes);
644   CAMLreturn(Nodes);
645 }
646
647 /* llmodule -> string -> llvalue -> unit */
648 CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef Val) {
649   LLVMAddNamedMetadataOperand(M, String_val(Name), Val);
650   return Val_unit;
651 }
652
653 /*--... Operations on scalar constants .....................................--*/
654
655 /* lltype -> int -> llvalue */
656 CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) {
657   return LLVMConstInt(IntTy, (long long) Int_val(N), 1);
658 }
659
660 /* lltype -> Int64.t -> bool -> llvalue */
661 CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
662                                           value SExt) {
663   return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
664 }
665
666 /* llvalue -> Int64.t */
667 CAMLprim value llvm_int64_of_const(LLVMValueRef Const)
668 {
669   CAMLparam0();
670   if (LLVMIsAConstantInt(Const) &&
671       LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64) {
672     value Option = alloc(1, 0);
673     Field(Option, 0) = caml_copy_int64(LLVMConstIntGetSExtValue(Const));
674     CAMLreturn(Option);
675   }
676   CAMLreturn(Val_int(0));
677 }
678
679 /* lltype -> string -> int -> llvalue */
680 CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
681                                                value Radix) {
682   return LLVMConstIntOfStringAndSize(IntTy, String_val(S), caml_string_length(S),
683                                      Int_val(Radix));
684 }
685
686 /* lltype -> float -> llvalue */
687 CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) {
688   return LLVMConstReal(RealTy, Double_val(N));
689 }
690
691 /* lltype -> string -> llvalue */
692 CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) {
693   return LLVMConstRealOfStringAndSize(RealTy, String_val(S),
694                                       caml_string_length(S));
695 }
696
697 /*--... Operations on composite constants ..................................--*/
698
699 /* llcontext -> string -> llvalue */
700 CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str,
701                                         value NullTerminate) {
702   return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
703                                   1);
704 }
705
706 /* llcontext -> string -> llvalue */
707 CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str,
708                                          value NullTerminate) {
709   return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
710                                   0);
711 }
712
713 /* lltype -> llvalue array -> llvalue */
714 CAMLprim LLVMValueRef llvm_const_array(LLVMTypeRef ElementTy,
715                                                value ElementVals) {
716   return LLVMConstArray(ElementTy, (LLVMValueRef*) Op_val(ElementVals),
717                         Wosize_val(ElementVals));
718 }
719
720 /* llcontext -> llvalue array -> llvalue */
721 CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) {
722   return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
723                                   Wosize_val(ElementVals), 0);
724 }
725
726 /* lltype -> llvalue array -> llvalue */
727 CAMLprim LLVMValueRef llvm_const_named_struct(LLVMTypeRef Ty, value ElementVals) {
728     return LLVMConstNamedStruct(Ty, (LLVMValueRef *) Op_val(ElementVals),  Wosize_val(ElementVals));
729 }
730
731 /* llcontext -> llvalue array -> llvalue */
732 CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C,
733                                                value ElementVals) {
734   return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
735                                   Wosize_val(ElementVals), 1);
736 }
737
738 /* llvalue array -> llvalue */
739 CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
740   return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals),
741                          Wosize_val(ElementVals));
742 }
743
744 /*--... Constant expressions ...............................................--*/
745
746 /* Icmp.t -> llvalue -> llvalue -> llvalue */
747 CAMLprim LLVMValueRef llvm_const_icmp(value Pred,
748                                       LLVMValueRef LHSConstant,
749                                       LLVMValueRef RHSConstant) {
750   return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant);
751 }
752
753 /* Fcmp.t -> llvalue -> llvalue -> llvalue */
754 CAMLprim LLVMValueRef llvm_const_fcmp(value Pred,
755                                       LLVMValueRef LHSConstant,
756                                       LLVMValueRef RHSConstant) {
757   return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant);
758 }
759
760 /* llvalue -> llvalue array -> llvalue */
761 CAMLprim LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) {
762   return LLVMConstGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
763                       Wosize_val(Indices));
764 }
765
766 /* llvalue -> llvalue array -> llvalue */
767 CAMLprim LLVMValueRef llvm_const_in_bounds_gep(LLVMValueRef ConstantVal,
768                                                value Indices) {
769   return LLVMConstInBoundsGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
770                               Wosize_val(Indices));
771 }
772
773 /* llvalue -> int array -> llvalue */
774 CAMLprim LLVMValueRef llvm_const_extractvalue(LLVMValueRef Aggregate,
775                                               value Indices) {
776   CAMLparam1(Indices);
777   int size = Wosize_val(Indices);
778   int i;
779   LLVMValueRef result;
780
781   unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
782   for (i = 0; i < size; i++) {
783     idxs[i] = Int_val(Field(Indices, i));
784   }
785
786   result = LLVMConstExtractValue(Aggregate, idxs, size);
787   free(idxs);
788   CAMLreturnT(LLVMValueRef, result);
789 }
790
791 /* llvalue -> llvalue -> int array -> llvalue */
792 CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate,
793                                              LLVMValueRef Val, value Indices) {
794   CAMLparam1(Indices);
795   int size = Wosize_val(Indices);
796   int i;
797   LLVMValueRef result;
798
799   unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
800   for (i = 0; i < size; i++) {
801     idxs[i] = Int_val(Field(Indices, i));
802   }
803
804   result = LLVMConstInsertValue(Aggregate, Val, idxs, size);
805   free(idxs);
806   CAMLreturnT(LLVMValueRef, result);
807 }
808
809 /* lltype -> string -> string -> bool -> bool -> llvalue */
810 CAMLprim LLVMValueRef llvm_const_inline_asm(LLVMTypeRef Ty, value Asm,
811                                      value Constraints, value HasSideEffects,
812                                      value IsAlignStack) {
813   return LLVMConstInlineAsm(Ty, String_val(Asm), String_val(Constraints),
814                             Bool_val(HasSideEffects), Bool_val(IsAlignStack));
815 }
816
817 /*--... Operations on global variables, functions, and aliases (globals) ...--*/
818
819 /* llvalue -> bool */
820 CAMLprim value llvm_is_declaration(LLVMValueRef Global) {
821   return Val_bool(LLVMIsDeclaration(Global));
822 }
823
824 /* llvalue -> Linkage.t */
825 CAMLprim value llvm_linkage(LLVMValueRef Global) {
826   return Val_int(LLVMGetLinkage(Global));
827 }
828
829 /* Linkage.t -> llvalue -> unit */
830 CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) {
831   LLVMSetLinkage(Global, Int_val(Linkage));
832   return Val_unit;
833 }
834
835 /* llvalue -> string */
836 CAMLprim value llvm_section(LLVMValueRef Global) {
837   return copy_string(LLVMGetSection(Global));
838 }
839
840 /* string -> llvalue -> unit */
841 CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) {
842   LLVMSetSection(Global, String_val(Section));
843   return Val_unit;
844 }
845
846 /* llvalue -> Visibility.t */
847 CAMLprim value llvm_visibility(LLVMValueRef Global) {
848   return Val_int(LLVMGetVisibility(Global));
849 }
850
851 /* Visibility.t -> llvalue -> unit */
852 CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) {
853   LLVMSetVisibility(Global, Int_val(Viz));
854   return Val_unit;
855 }
856
857 /* llvalue -> int */
858 CAMLprim value llvm_alignment(LLVMValueRef Global) {
859   return Val_int(LLVMGetAlignment(Global));
860 }
861
862 /* int -> llvalue -> unit */
863 CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
864   LLVMSetAlignment(Global, Int_val(Bytes));
865   return Val_unit;
866 }
867
868 /*--... Operations on uses .................................................--*/
869
870 /* llvalue -> lluse option */
871 CAMLprim value llvm_use_begin(LLVMValueRef Val) {
872   CAMLparam0();
873   LLVMUseRef First;
874   if ((First = LLVMGetFirstUse(Val))) {
875     value Option = alloc(1, 0);
876     Field(Option, 0) = (value) First;
877     CAMLreturn(Option);
878   }
879   CAMLreturn(Val_int(0));
880 }
881
882 /* lluse -> lluse option */
883 CAMLprim value llvm_use_succ(LLVMUseRef U) {
884   CAMLparam0();
885   LLVMUseRef Next;
886   if ((Next = LLVMGetNextUse(U))) {
887     value Option = alloc(1, 0);
888     Field(Option, 0) = (value) Next;
889     CAMLreturn(Option);
890   }
891   CAMLreturn(Val_int(0));
892 }
893
894 /* lluse -> llvalue */
895 CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) {
896   return LLVMGetUser(UR);
897 }
898
899 /* lluse -> llvalue */
900 CAMLprim LLVMValueRef llvm_used_value(LLVMUseRef UR) {
901   return LLVMGetUsedValue(UR);
902 }
903
904 /*--... Operations on global variables .....................................--*/
905
906 DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef,
907                  LLVMGetGlobalParent)
908
909 /* lltype -> string -> llmodule -> llvalue */
910 CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
911                                           LLVMModuleRef M) {
912   LLVMValueRef GlobalVar;
913   if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
914     if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
915       return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty, 0));
916     return GlobalVar;
917   }
918   return LLVMAddGlobal(M, Ty, String_val(Name));
919 }
920
921 /* lltype -> string -> int -> llmodule -> llvalue */
922 CAMLprim LLVMValueRef llvm_declare_qualified_global(LLVMTypeRef Ty, value Name,
923                                                     value AddressSpace,
924                                                     LLVMModuleRef M) {
925   LLVMValueRef GlobalVar;
926   if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
927     if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
928       return LLVMConstBitCast(GlobalVar,
929                               LLVMPointerType(Ty, Int_val(AddressSpace)));
930     return GlobalVar;
931   }
932   return LLVMAddGlobal(M, Ty, String_val(Name));
933 }
934
935 /* string -> llmodule -> llvalue option */
936 CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
937   CAMLparam1(Name);
938   LLVMValueRef GlobalVar;
939   if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
940     value Option = alloc(1, 0);
941     Field(Option, 0) = (value) GlobalVar;
942     CAMLreturn(Option);
943   }
944   CAMLreturn(Val_int(0));
945 }
946
947 /* string -> llvalue -> llmodule -> llvalue */
948 CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
949                                          LLVMModuleRef M) {
950   LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer),
951                                          String_val(Name));
952   LLVMSetInitializer(GlobalVar, Initializer);
953   return GlobalVar;
954 }
955
956 /* string -> llvalue -> int -> llmodule -> llvalue */
957 CAMLprim LLVMValueRef llvm_define_qualified_global(value Name,
958                                                    LLVMValueRef Initializer,
959                                                    value AddressSpace,
960                                                    LLVMModuleRef M) {
961   LLVMValueRef GlobalVar = LLVMAddGlobalInAddressSpace(M,
962                                                        LLVMTypeOf(Initializer),
963                                                        String_val(Name),
964                                                        Int_val(AddressSpace));
965   LLVMSetInitializer(GlobalVar, Initializer);
966   return GlobalVar;
967 }
968
969 /* llvalue -> unit */
970 CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) {
971   LLVMDeleteGlobal(GlobalVar);
972   return Val_unit;
973 }
974
975 /* llvalue -> llvalue -> unit */
976 CAMLprim value llvm_set_initializer(LLVMValueRef ConstantVal,
977                                     LLVMValueRef GlobalVar) {
978   LLVMSetInitializer(GlobalVar, ConstantVal);
979   return Val_unit;
980 }
981
982 /* llvalue -> unit */
983 CAMLprim value llvm_remove_initializer(LLVMValueRef GlobalVar) {
984   LLVMSetInitializer(GlobalVar, NULL);
985   return Val_unit;
986 }
987
988 /* llvalue -> bool */
989 CAMLprim value llvm_is_thread_local(LLVMValueRef GlobalVar) {
990   return Val_bool(LLVMIsThreadLocal(GlobalVar));
991 }
992
993 /* bool -> llvalue -> unit */
994 CAMLprim value llvm_set_thread_local(value IsThreadLocal,
995                                      LLVMValueRef GlobalVar) {
996   LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal));
997   return Val_unit;
998 }
999
1000 /* llvalue -> ThreadLocalMode.t */
1001 CAMLprim value llvm_thread_local_mode(LLVMValueRef GlobalVar) {
1002   return Val_int(LLVMGetThreadLocalMode(GlobalVar));
1003 }
1004
1005 /* ThreadLocalMode.t -> llvalue -> unit */
1006 CAMLprim value llvm_set_thread_local_mode(value ThreadLocalMode,
1007                                           LLVMValueRef GlobalVar) {
1008   LLVMSetThreadLocalMode(GlobalVar, Int_val(ThreadLocalMode));
1009   return Val_unit;
1010 }
1011
1012 /* llvalue -> bool */
1013 CAMLprim value llvm_is_externally_initialized(LLVMValueRef GlobalVar) {
1014   return Val_bool(LLVMIsExternallyInitialized(GlobalVar));
1015 }
1016
1017 /* bool -> llvalue -> unit */
1018 CAMLprim value llvm_set_externally_initialized(value IsExternallyInitialized,
1019                                                LLVMValueRef GlobalVar) {
1020   LLVMSetExternallyInitialized(GlobalVar, Bool_val(IsExternallyInitialized));
1021   return Val_unit;
1022 }
1023
1024 /* llvalue -> bool */
1025 CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) {
1026   return Val_bool(LLVMIsGlobalConstant(GlobalVar));
1027 }
1028
1029 /* bool -> llvalue -> unit */
1030 CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
1031   LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag));
1032   return Val_unit;
1033 }
1034
1035 /*--... Operations on aliases ..............................................--*/
1036
1037 CAMLprim LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty,
1038                                      LLVMValueRef Aliasee, value Name) {
1039   return LLVMAddAlias(M, Ty, Aliasee, String_val(Name));
1040 }
1041
1042 /*--... Operations on functions ............................................--*/
1043
1044 DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef,
1045                  LLVMGetGlobalParent)
1046
1047 /* string -> lltype -> llmodule -> llvalue */
1048 CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
1049                                             LLVMModuleRef M) {
1050   LLVMValueRef Fn;
1051   if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
1052     if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
1053       return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0));
1054     return Fn;
1055   }
1056   return LLVMAddFunction(M, String_val(Name), Ty);
1057 }
1058
1059 /* string -> llmodule -> llvalue option */
1060 CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
1061   CAMLparam1(Name);
1062   LLVMValueRef Fn;
1063   if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
1064     value Option = alloc(1, 0);
1065     Field(Option, 0) = (value) Fn;
1066     CAMLreturn(Option);
1067   }
1068   CAMLreturn(Val_int(0));
1069 }
1070
1071 /* string -> lltype -> llmodule -> llvalue */
1072 CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
1073                                            LLVMModuleRef M) {
1074   LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
1075   LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry");
1076   return Fn;
1077 }
1078
1079 /* llvalue -> unit */
1080 CAMLprim value llvm_delete_function(LLVMValueRef Fn) {
1081   LLVMDeleteFunction(Fn);
1082   return Val_unit;
1083 }
1084
1085 /* llvalue -> bool */
1086 CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) {
1087   return Val_bool(LLVMGetIntrinsicID(Fn));
1088 }
1089
1090 /* llvalue -> int */
1091 CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) {
1092   return Val_int(LLVMGetFunctionCallConv(Fn));
1093 }
1094
1095 /* int -> llvalue -> unit */
1096 CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) {
1097   LLVMSetFunctionCallConv(Fn, Int_val(Id));
1098   return Val_unit;
1099 }
1100
1101 /* llvalue -> string option */
1102 CAMLprim value llvm_gc(LLVMValueRef Fn) {
1103   const char *GC;
1104   CAMLparam0();
1105   CAMLlocal2(Name, Option);
1106   
1107   if ((GC = LLVMGetGC(Fn))) {
1108     Name = copy_string(GC);
1109     
1110     Option = alloc(1, 0);
1111     Field(Option, 0) = Name;
1112     CAMLreturn(Option);
1113   } else {
1114     CAMLreturn(Val_int(0));
1115   }
1116 }
1117
1118 /* string option -> llvalue -> unit */
1119 CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
1120   LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0)));
1121   return Val_unit;
1122 }
1123
1124 /* llvalue -> int32 -> unit */
1125 CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
1126   LLVMAddFunctionAttr(Arg, Int32_val(PA));
1127   return Val_unit;
1128 }
1129
1130 /* llvalue -> string -> string -> unit */
1131 CAMLprim value llvm_add_target_dependent_function_attr(
1132                   LLVMValueRef Arg, value A, value V) {
1133   LLVMAddTargetDependentFunctionAttr(Arg, String_val(A), String_val(V));
1134   return Val_unit;
1135 }
1136
1137 /* llvalue -> int32 */
1138 CAMLprim value llvm_function_attr(LLVMValueRef Fn)
1139 {
1140     CAMLparam0();
1141     CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
1142 }
1143
1144 /* llvalue -> int32 -> unit */
1145 CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
1146   LLVMRemoveFunctionAttr(Arg, Int32_val(PA));
1147   return Val_unit;
1148 }
1149 /*--... Operations on parameters ...........................................--*/
1150
1151 DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
1152
1153 /* llvalue -> int -> llvalue */
1154 CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
1155   return LLVMGetParam(Fn, Int_val(Index));
1156 }
1157
1158 /* llvalue -> int */
1159 CAMLprim value llvm_param_attr(LLVMValueRef Param)
1160 {
1161     CAMLparam0();
1162     CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
1163 }
1164
1165 /* llvalue -> llvalue */
1166 CAMLprim value llvm_params(LLVMValueRef Fn) {
1167   value Params = alloc(LLVMCountParams(Fn), 0);
1168   LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
1169   return Params;
1170 }
1171
1172 /* llvalue -> int32 -> unit */
1173 CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
1174   LLVMAddAttribute(Arg, Int32_val(PA));
1175   return Val_unit;
1176 }
1177
1178 /* llvalue -> int32 -> unit */
1179 CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
1180   LLVMRemoveAttribute(Arg, Int32_val(PA));
1181   return Val_unit;
1182 }
1183
1184 /* llvalue -> int -> unit */
1185 CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
1186   LLVMSetParamAlignment(Arg, Int_val(align));
1187   return Val_unit;
1188 }
1189
1190 /*--... Operations on basic blocks .........................................--*/
1191
1192 DEFINE_ITERATORS(
1193   block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
1194
1195 /* llbasicblock -> llvalue option */
1196 CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
1197 {
1198   CAMLparam0();
1199   LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
1200   if (Term) {
1201     value Option = alloc(1, 0);
1202     Field(Option, 0) = (value) Term;
1203     CAMLreturn(Option);
1204   }
1205   CAMLreturn(Val_int(0));
1206 }
1207
1208 /* llvalue -> llbasicblock array */
1209 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
1210   value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
1211   LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
1212   return MLArray;
1213 }
1214
1215 /* llbasicblock -> unit */
1216 CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
1217   LLVMDeleteBasicBlock(BB);
1218   return Val_unit;
1219 }
1220
1221 /* llbasicblock -> unit */
1222 CAMLprim value llvm_remove_block(LLVMBasicBlockRef BB) {
1223   LLVMRemoveBasicBlockFromParent(BB);
1224   return Val_unit;
1225 }
1226
1227 /* llbasicblock -> llbasicblock -> unit */
1228 CAMLprim value llvm_move_block_before(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1229   LLVMMoveBasicBlockBefore(BB, Pos);
1230   return Val_unit;
1231 }
1232
1233 /* llbasicblock -> llbasicblock -> unit */
1234 CAMLprim value llvm_move_block_after(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1235   LLVMMoveBasicBlockAfter(BB, Pos);
1236   return Val_unit;
1237 }
1238
1239 /* string -> llvalue -> llbasicblock */
1240 CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
1241                                              LLVMValueRef Fn) {
1242   return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name));
1243 }
1244
1245 /* string -> llbasicblock -> llbasicblock */
1246 CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name,
1247                                              LLVMBasicBlockRef BB) {
1248   return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name));
1249 }
1250
1251 /* llvalue -> bool */
1252 CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
1253   return Val_bool(LLVMValueIsBasicBlock(Val));
1254 }
1255
1256 /*--... Operations on instructions .........................................--*/
1257
1258 DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
1259                  LLVMGetInstructionParent)
1260
1261 /* llvalue -> Opcode.t */
1262 CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
1263   LLVMOpcode o;
1264   if (!LLVMIsAInstruction(Inst))
1265       failwith("Not an instruction");
1266   o = LLVMGetInstructionOpcode(Inst);
1267   assert (o <= LLVMLandingPad);
1268   return Val_int(o);
1269 }
1270
1271 /* llvalue -> ICmp.t */
1272 CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
1273   CAMLparam0();
1274   int x = LLVMGetICmpPredicate(Val);
1275   if (x) {
1276     value Option = alloc(1, 0);
1277     Field(Option, 0) = Val_int(x - LLVMIntEQ);
1278     CAMLreturn(Option);
1279   }
1280   CAMLreturn(Val_int(0));
1281 }
1282
1283
1284 /*--... Operations on call sites ...........................................--*/
1285
1286 /* llvalue -> int */
1287 CAMLprim value llvm_instruction_call_conv(LLVMValueRef Inst) {
1288   return Val_int(LLVMGetInstructionCallConv(Inst));
1289 }
1290
1291 /* int -> llvalue -> unit */
1292 CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
1293   LLVMSetInstructionCallConv(Inst, Int_val(CC));
1294   return Val_unit;
1295 }
1296
1297 /* llvalue -> int -> int32 -> unit */
1298 CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
1299                                                value index,
1300                                                value PA) {
1301   LLVMAddInstrAttribute(Instr, Int_val(index), Int32_val(PA));
1302   return Val_unit;
1303 }
1304
1305 /* llvalue -> int -> int32 -> unit */
1306 CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
1307                                                   value index,
1308                                                   value PA) {
1309   LLVMRemoveInstrAttribute(Instr, Int_val(index), Int32_val(PA));
1310   return Val_unit;
1311 }
1312
1313 /*--... Operations on call instructions (only) .............................--*/
1314
1315 /* llvalue -> bool */
1316 CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) {
1317   return Val_bool(LLVMIsTailCall(CallInst));
1318 }
1319
1320 /* bool -> llvalue -> unit */
1321 CAMLprim value llvm_set_tail_call(value IsTailCall,
1322                                   LLVMValueRef CallInst) {
1323   LLVMSetTailCall(CallInst, Bool_val(IsTailCall));
1324   return Val_unit;
1325 }
1326
1327 /*--... Operations on load/store instructions (only)........................--*/
1328
1329 /* llvalue -> bool */
1330 CAMLprim value llvm_is_volatile(LLVMValueRef MemoryInst) {
1331   return Val_bool(LLVMGetVolatile(MemoryInst));
1332 }
1333
1334 /* bool -> llvalue -> unit */
1335 CAMLprim value llvm_set_volatile(value IsVolatile,
1336                                   LLVMValueRef MemoryInst) {
1337   LLVMSetVolatile(MemoryInst, Bool_val(IsVolatile));
1338   return Val_unit;
1339 }
1340
1341 /*--... Operations on phi nodes ............................................--*/
1342
1343 /* (llvalue * llbasicblock) -> llvalue -> unit */
1344 CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
1345   LLVMAddIncoming(PhiNode,
1346                   (LLVMValueRef*) &Field(Incoming, 0),
1347                   (LLVMBasicBlockRef*) &Field(Incoming, 1),
1348                   1);
1349   return Val_unit;
1350 }
1351
1352 /* llvalue -> (llvalue * llbasicblock) list */
1353 CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
1354   unsigned I;
1355   CAMLparam0();
1356   CAMLlocal3(Hd, Tl, Tmp);
1357   
1358   /* Build a tuple list of them. */
1359   Tl = Val_int(0);
1360   for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
1361     Hd = alloc(2, 0);
1362     Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
1363     Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
1364     
1365     Tmp = alloc(2, 0);
1366     Store_field(Tmp, 0, Hd);
1367     Store_field(Tmp, 1, Tl);
1368     Tl = Tmp;
1369   }
1370   
1371   CAMLreturn(Tl);
1372 }
1373
1374 /* llvalue -> unit */
1375 CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
1376   LLVMInstructionEraseFromParent(Instruction);
1377   return Val_unit;
1378 }
1379
1380 /*===-- Instruction builders ----------------------------------------------===*/
1381
1382 #define Builder_val(v)  (*(LLVMBuilderRef *)(Data_custom_val(v)))
1383
1384 static void llvm_finalize_builder(value B) {
1385   LLVMDisposeBuilder(Builder_val(B));
1386 }
1387
1388 static struct custom_operations builder_ops = {
1389   (char *) "IRBuilder",
1390   llvm_finalize_builder,
1391   custom_compare_default,
1392   custom_hash_default,
1393   custom_serialize_default,
1394   custom_deserialize_default
1395 #ifdef custom_compare_ext_default
1396   , custom_compare_ext_default
1397 #endif
1398 };
1399
1400 static value alloc_builder(LLVMBuilderRef B) {
1401   value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
1402   Builder_val(V) = B;
1403   return V;
1404 }
1405
1406 /* llcontext -> llbuilder */
1407 CAMLprim value llvm_builder(LLVMContextRef C) {
1408   return alloc_builder(LLVMCreateBuilderInContext(C));
1409 }
1410
1411 /* (llbasicblock, llvalue) llpos -> llbuilder -> unit */
1412 CAMLprim value llvm_position_builder(value Pos, value B) {
1413   if (Tag_val(Pos) == 0) {
1414     LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0));
1415     LLVMPositionBuilderAtEnd(Builder_val(B), BB);
1416   } else {
1417     LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0));
1418     LLVMPositionBuilderBefore(Builder_val(B), I);
1419   }
1420   return Val_unit;
1421 }
1422
1423 /* llbuilder -> llbasicblock */
1424 CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) {
1425   LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
1426   if (!InsertBlock)
1427     raise_not_found();
1428   return InsertBlock;
1429 }
1430
1431 /* llvalue -> string -> llbuilder -> unit */
1432 CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) {
1433   LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name));
1434   return Val_unit;
1435 }
1436
1437 /*--... Metadata ...........................................................--*/
1438
1439 /* llbuilder -> llvalue -> unit */
1440 CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) {
1441   LLVMSetCurrentDebugLocation(Builder_val(B), V);
1442   return Val_unit;
1443 }
1444
1445 /* llbuilder -> unit */
1446 CAMLprim value llvm_clear_current_debug_location(value B) {
1447   LLVMSetCurrentDebugLocation(Builder_val(B), NULL);
1448   return Val_unit;
1449 }
1450
1451 /* llbuilder -> llvalue option */
1452 CAMLprim value llvm_current_debug_location(value B) {
1453   CAMLparam0();
1454   LLVMValueRef L;
1455   if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) {
1456     value Option = alloc(1, 0);
1457     Field(Option, 0) = (value) L;
1458     CAMLreturn(Option);
1459   }
1460   CAMLreturn(Val_int(0));
1461 }
1462
1463 /* llbuilder -> llvalue -> unit */
1464 CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) {
1465   LLVMSetInstDebugLocation(Builder_val(B), V);
1466   return Val_unit;
1467 }
1468
1469
1470 /*--... Terminators ........................................................--*/
1471
1472 /* llbuilder -> llvalue */
1473 CAMLprim LLVMValueRef llvm_build_ret_void(value B) {
1474   return LLVMBuildRetVoid(Builder_val(B));
1475 }
1476
1477 /* llvalue -> llbuilder -> llvalue */
1478 CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) {
1479   return LLVMBuildRet(Builder_val(B), Val);
1480 }
1481
1482 /* llvalue array -> llbuilder -> llvalue */
1483 CAMLprim LLVMValueRef llvm_build_aggregate_ret(value RetVals, value B) {
1484   return LLVMBuildAggregateRet(Builder_val(B), (LLVMValueRef *) Op_val(RetVals),
1485                                Wosize_val(RetVals));
1486 }
1487
1488 /* llbasicblock -> llbuilder -> llvalue */
1489 CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) {
1490   return LLVMBuildBr(Builder_val(B), BB);
1491 }
1492
1493 /* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */
1494 CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If,
1495                                          LLVMBasicBlockRef Then,
1496                                          LLVMBasicBlockRef Else,
1497                                          value B) {
1498   return LLVMBuildCondBr(Builder_val(B), If, Then, Else);
1499 }
1500
1501 /* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */
1502 CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
1503                                         LLVMBasicBlockRef Else,
1504                                         value EstimatedCount,
1505                                         value B) {
1506   return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
1507 }
1508
1509 /* lltype -> string -> llbuilder -> llvalue */
1510 CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
1511                                         value B)
1512 {
1513   return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
1514 }
1515
1516 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
1517 CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
1518                                               LLVMValueRef Val,
1519                                               value Name, value B)
1520 {
1521   return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
1522 }
1523
1524 /* llvalue -> llbuilder -> llvalue */
1525 CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
1526 {
1527   return LLVMBuildFree(Builder_val(B), P);
1528 }
1529
1530 /* llvalue -> llvalue -> llbasicblock -> unit */
1531 CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
1532                              LLVMBasicBlockRef Dest) {
1533   LLVMAddCase(Switch, OnVal, Dest);
1534   return Val_unit;
1535 }
1536
1537 /* llvalue -> llbasicblock -> llbuilder -> llvalue */
1538 CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr,
1539                                              value EstimatedDests,
1540                                              value B) {
1541   return LLVMBuildIndirectBr(Builder_val(B), Addr, EstimatedDests);
1542 }
1543
1544 /* llvalue -> llvalue -> llbasicblock -> unit */
1545 CAMLprim value llvm_add_destination(LLVMValueRef IndirectBr,
1546                                     LLVMBasicBlockRef Dest) {
1547   LLVMAddDestination(IndirectBr, Dest);
1548   return Val_unit;
1549 }
1550
1551 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1552    llbuilder -> llvalue */
1553 CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
1554                                             LLVMBasicBlockRef Then,
1555                                             LLVMBasicBlockRef Catch,
1556                                             value Name, value B) {
1557   return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Args),
1558                          Wosize_val(Args), Then, Catch, String_val(Name));
1559 }
1560
1561 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1562    llbuilder -> llvalue */
1563 CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
1564   return llvm_build_invoke_nat((LLVMValueRef) Args[0], Args[1],
1565                                (LLVMBasicBlockRef) Args[2],
1566                                (LLVMBasicBlockRef) Args[3],
1567                                Args[4], Args[5]);
1568 }
1569
1570 /* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
1571 CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
1572                                             value NumClauses,  value Name,
1573                                             value B) {
1574     return LLVMBuildLandingPad(Builder_val(B), Ty, PersFn, Int_val(NumClauses),
1575                                String_val(Name));
1576 }
1577
1578 /* llvalue -> llvalue -> unit */
1579 CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
1580 {
1581     LLVMAddClause(LandingPadInst, ClauseVal);
1582     return Val_unit;
1583 }
1584
1585
1586 /* llvalue -> bool -> unit */
1587 CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
1588 {
1589     LLVMSetCleanup(LandingPadInst, Bool_val(flag));
1590     return Val_unit;
1591 }
1592
1593 /* llvalue -> llbuilder -> llvalue */
1594 CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
1595 {
1596     return LLVMBuildResume(Builder_val(B), Exn);
1597 }
1598
1599 /* llbuilder -> llvalue */
1600 CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
1601   return LLVMBuildUnreachable(Builder_val(B));
1602 }
1603
1604 /*--... Arithmetic .........................................................--*/
1605
1606 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1607 CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS,
1608                                      value Name, value B) {
1609   return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name));
1610 }
1611
1612 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1613 CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1614                                          value Name, value B) {
1615   return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1616 }
1617
1618 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1619 CAMLprim LLVMValueRef llvm_build_nuw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1620                                          value Name, value B) {
1621   return LLVMBuildNUWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1622 }
1623
1624 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1625 CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS,
1626                                       value Name, value B) {
1627   return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name));
1628 }
1629
1630 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1631 CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1632                                      value Name, value B) {
1633   return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name));
1634 }
1635
1636 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1637 CAMLprim LLVMValueRef llvm_build_nsw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1638                                          value Name, value B) {
1639   return LLVMBuildNSWSub(Builder_val(B), LHS, RHS, String_val(Name));
1640 }
1641
1642 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1643 CAMLprim LLVMValueRef llvm_build_nuw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1644                                          value Name, value B) {
1645   return LLVMBuildNUWSub(Builder_val(B), LHS, RHS, String_val(Name));
1646 }
1647
1648 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1649 CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS,
1650                                       value Name, value B) {
1651   return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name));
1652 }
1653
1654 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1655 CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1656                                      value Name, value B) {
1657   return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name));
1658 }
1659
1660 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1661 CAMLprim LLVMValueRef llvm_build_nsw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1662                                          value Name, value B) {
1663   return LLVMBuildNSWMul(Builder_val(B), LHS, RHS, String_val(Name));
1664 }
1665
1666 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1667 CAMLprim LLVMValueRef llvm_build_nuw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1668                                          value Name, value B) {
1669   return LLVMBuildNUWMul(Builder_val(B), LHS, RHS, String_val(Name));
1670 }
1671
1672 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1673 CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS,
1674                                       value Name, value B) {
1675   return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name));
1676 }
1677
1678 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1679 CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS,
1680                                       value Name, value B) {
1681   return LLVMBuildUDiv(Builder_val(B), LHS, RHS, String_val(Name));
1682 }
1683
1684 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1685 CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1686                                       value Name, value B) {
1687   return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1688 }
1689
1690 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1691 CAMLprim LLVMValueRef llvm_build_exact_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1692                                             value Name, value B) {
1693   return LLVMBuildExactSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1694 }
1695
1696 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1697 CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1698                                       value Name, value B) {
1699   return LLVMBuildFDiv(Builder_val(B), LHS, RHS, String_val(Name));
1700 }
1701
1702 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1703 CAMLprim LLVMValueRef llvm_build_urem(LLVMValueRef LHS, LLVMValueRef RHS,
1704                                       value Name, value B) {
1705   return LLVMBuildURem(Builder_val(B), LHS, RHS, String_val(Name));
1706 }
1707
1708 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1709 CAMLprim LLVMValueRef llvm_build_srem(LLVMValueRef LHS, LLVMValueRef RHS,
1710                                       value Name, value B) {
1711   return LLVMBuildSRem(Builder_val(B), LHS, RHS, String_val(Name));
1712 }
1713
1714 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1715 CAMLprim LLVMValueRef llvm_build_frem(LLVMValueRef LHS, LLVMValueRef RHS,
1716                                       value Name, value B) {
1717   return LLVMBuildFRem(Builder_val(B), LHS, RHS, String_val(Name));
1718 }
1719
1720 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1721 CAMLprim LLVMValueRef llvm_build_shl(LLVMValueRef LHS, LLVMValueRef RHS,
1722                                      value Name, value B) {
1723   return LLVMBuildShl(Builder_val(B), LHS, RHS, String_val(Name));
1724 }
1725
1726 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1727 CAMLprim LLVMValueRef llvm_build_lshr(LLVMValueRef LHS, LLVMValueRef RHS,
1728                                       value Name, value B) {
1729   return LLVMBuildLShr(Builder_val(B), LHS, RHS, String_val(Name));
1730 }
1731
1732 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1733 CAMLprim LLVMValueRef llvm_build_ashr(LLVMValueRef LHS, LLVMValueRef RHS,
1734                                       value Name, value B) {
1735   return LLVMBuildAShr(Builder_val(B), LHS, RHS, String_val(Name));
1736 }
1737
1738 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1739 CAMLprim LLVMValueRef llvm_build_and(LLVMValueRef LHS, LLVMValueRef RHS,
1740                                      value Name, value B) {
1741   return LLVMBuildAnd(Builder_val(B), LHS, RHS, String_val(Name));
1742 }
1743
1744 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1745 CAMLprim LLVMValueRef llvm_build_or(LLVMValueRef LHS, LLVMValueRef RHS,
1746                                     value Name, value B) {
1747   return LLVMBuildOr(Builder_val(B), LHS, RHS, String_val(Name));
1748 }
1749
1750 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1751 CAMLprim LLVMValueRef llvm_build_xor(LLVMValueRef LHS, LLVMValueRef RHS,
1752                                      value Name, value B) {
1753   return LLVMBuildXor(Builder_val(B), LHS, RHS, String_val(Name));
1754 }
1755
1756 /* llvalue -> string -> llbuilder -> llvalue */
1757 CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X,
1758                                      value Name, value B) {
1759   return LLVMBuildNeg(Builder_val(B), X, String_val(Name));
1760 }
1761
1762 /* llvalue -> string -> llbuilder -> llvalue */
1763 CAMLprim LLVMValueRef llvm_build_nsw_neg(LLVMValueRef X,
1764                                          value Name, value B) {
1765   return LLVMBuildNSWNeg(Builder_val(B), X, String_val(Name));
1766 }
1767
1768 /* llvalue -> string -> llbuilder -> llvalue */
1769 CAMLprim LLVMValueRef llvm_build_nuw_neg(LLVMValueRef X,
1770                                          value Name, value B) {
1771   return LLVMBuildNUWNeg(Builder_val(B), X, String_val(Name));
1772 }
1773
1774 /* llvalue -> string -> llbuilder -> llvalue */
1775 CAMLprim LLVMValueRef llvm_build_fneg(LLVMValueRef X,
1776                                      value Name, value B) {
1777   return LLVMBuildFNeg(Builder_val(B), X, String_val(Name));
1778 }
1779
1780 /* llvalue -> string -> llbuilder -> llvalue */
1781 CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X,
1782                                      value Name, value B) {
1783   return LLVMBuildNot(Builder_val(B), X, String_val(Name));
1784 }
1785
1786 /*--... Memory .............................................................--*/
1787
1788 /* lltype -> string -> llbuilder -> llvalue */
1789 CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty,
1790                                         value Name, value B) {
1791   return LLVMBuildAlloca(Builder_val(B), Ty, String_val(Name));
1792 }
1793
1794 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
1795 CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size,
1796                                               value Name, value B) {
1797   return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name));
1798 }
1799
1800 /* llvalue -> string -> llbuilder -> llvalue */
1801 CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer,
1802                                       value Name, value B) {
1803   return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name));
1804 }
1805
1806 /* llvalue -> llvalue -> llbuilder -> llvalue */
1807 CAMLprim LLVMValueRef llvm_build_store(LLVMValueRef Value, LLVMValueRef Pointer,
1808                                        value B) {
1809   return LLVMBuildStore(Builder_val(B), Value, Pointer);
1810 }
1811
1812 /* AtomicRMWBinOp.t -> llvalue -> llvalue -> AtomicOrdering.t ->
1813    bool -> llbuilder -> llvalue */
1814 CAMLprim LLVMValueRef llvm_build_atomicrmw_native(value BinOp, LLVMValueRef Ptr,
1815                                                   LLVMValueRef Val, value Ord,
1816                                                   value ST, value Name, value B) {
1817   LLVMValueRef Instr;
1818   Instr = LLVMBuildAtomicRMW(Builder_val(B), Int_val(BinOp),
1819                              Ptr, Val, Int_val(Ord), Bool_val(ST));
1820   LLVMSetValueName(Instr, String_val(Name));
1821   return Instr;
1822 }
1823
1824 CAMLprim LLVMValueRef llvm_build_atomicrmw_bytecode(value *argv, int argn) {
1825   return llvm_build_atomicrmw_native(argv[0], (LLVMValueRef) argv[1],
1826                                      (LLVMValueRef) argv[2], argv[3],
1827                                      argv[4], argv[5], argv[6]);
1828 }
1829
1830 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1831 CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices,
1832                                      value Name, value B) {
1833   return LLVMBuildGEP(Builder_val(B), Pointer,
1834                       (LLVMValueRef *) Op_val(Indices), Wosize_val(Indices),
1835                       String_val(Name));
1836 }
1837
1838 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1839 CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer,
1840                                                value Indices, value Name,
1841                                                value B) {
1842   return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
1843                               (LLVMValueRef *) Op_val(Indices),
1844                               Wosize_val(Indices), String_val(Name));
1845 }
1846
1847 /* llvalue -> int -> string -> llbuilder -> llvalue */
1848 CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer,
1849                                                value Index, value Name,
1850                                                value B) {
1851   return LLVMBuildStructGEP(Builder_val(B), Pointer,
1852                               Int_val(Index), String_val(Name));
1853 }
1854
1855 /* string -> string -> llbuilder -> llvalue */
1856 CAMLprim LLVMValueRef llvm_build_global_string(value Str, value Name, value B) {
1857   return LLVMBuildGlobalString(Builder_val(B), String_val(Str),
1858                                String_val(Name));
1859 }
1860
1861 /* string -> string -> llbuilder -> llvalue */
1862 CAMLprim LLVMValueRef llvm_build_global_stringptr(value Str, value Name,
1863                                                   value B) {
1864   return LLVMBuildGlobalStringPtr(Builder_val(B), String_val(Str),
1865                                   String_val(Name));
1866 }
1867
1868 /*--... Casts ..............................................................--*/
1869
1870 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1871 CAMLprim LLVMValueRef llvm_build_trunc(LLVMValueRef X, LLVMTypeRef Ty,
1872                                        value Name, value B) {
1873   return LLVMBuildTrunc(Builder_val(B), X, Ty, String_val(Name));
1874 }
1875
1876 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1877 CAMLprim LLVMValueRef llvm_build_zext(LLVMValueRef X, LLVMTypeRef Ty,
1878                                       value Name, value B) {
1879   return LLVMBuildZExt(Builder_val(B), X, Ty, String_val(Name));
1880 }
1881
1882 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1883 CAMLprim LLVMValueRef llvm_build_sext(LLVMValueRef X, LLVMTypeRef Ty,
1884                                       value Name, value B) {
1885   return LLVMBuildSExt(Builder_val(B), X, Ty, String_val(Name));
1886 }
1887
1888 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1889 CAMLprim LLVMValueRef llvm_build_fptoui(LLVMValueRef X, LLVMTypeRef Ty,
1890                                         value Name, value B) {
1891   return LLVMBuildFPToUI(Builder_val(B), X, Ty, String_val(Name));
1892 }
1893
1894 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1895 CAMLprim LLVMValueRef llvm_build_fptosi(LLVMValueRef X, LLVMTypeRef Ty,
1896                                         value Name, value B) {
1897   return LLVMBuildFPToSI(Builder_val(B), X, Ty, String_val(Name));
1898 }
1899
1900 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1901 CAMLprim LLVMValueRef llvm_build_uitofp(LLVMValueRef X, LLVMTypeRef Ty,
1902                                         value Name, value B) {
1903   return LLVMBuildUIToFP(Builder_val(B), X, Ty, String_val(Name));
1904 }
1905
1906 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1907 CAMLprim LLVMValueRef llvm_build_sitofp(LLVMValueRef X, LLVMTypeRef Ty,
1908                                         value Name, value B) {
1909   return LLVMBuildSIToFP(Builder_val(B), X, Ty, String_val(Name));
1910 }
1911
1912 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1913 CAMLprim LLVMValueRef llvm_build_fptrunc(LLVMValueRef X, LLVMTypeRef Ty,
1914                                          value Name, value B) {
1915   return LLVMBuildFPTrunc(Builder_val(B), X, Ty, String_val(Name));
1916 }
1917
1918 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1919 CAMLprim LLVMValueRef llvm_build_fpext(LLVMValueRef X, LLVMTypeRef Ty,
1920                                        value Name, value B) {
1921   return LLVMBuildFPExt(Builder_val(B), X, Ty, String_val(Name));
1922 }
1923
1924 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1925 CAMLprim LLVMValueRef llvm_build_prttoint(LLVMValueRef X, LLVMTypeRef Ty,
1926                                           value Name, value B) {
1927   return LLVMBuildPtrToInt(Builder_val(B), X, Ty, String_val(Name));
1928 }
1929
1930 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1931 CAMLprim LLVMValueRef llvm_build_inttoptr(LLVMValueRef X, LLVMTypeRef Ty,
1932                                           value Name, value B) {
1933   return LLVMBuildIntToPtr(Builder_val(B), X, Ty, String_val(Name));
1934 }
1935
1936 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1937 CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1938                                          value Name, value B) {
1939   return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name));
1940 }
1941
1942 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1943 CAMLprim LLVMValueRef llvm_build_zext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1944                                                  value Name, value B) {
1945   return LLVMBuildZExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1946 }
1947
1948 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1949 CAMLprim LLVMValueRef llvm_build_sext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1950                                                  value Name, value B) {
1951   return LLVMBuildSExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1952 }
1953
1954 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1955 CAMLprim LLVMValueRef llvm_build_trunc_or_bitcast(LLVMValueRef X,
1956                                                   LLVMTypeRef Ty, value Name,
1957                                                   value B) {
1958   return LLVMBuildTruncOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1959 }
1960
1961 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1962 CAMLprim LLVMValueRef llvm_build_pointercast(LLVMValueRef X, LLVMTypeRef Ty,
1963                                              value Name, value B) {
1964   return LLVMBuildPointerCast(Builder_val(B), X, Ty, String_val(Name));
1965 }
1966
1967 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1968 CAMLprim LLVMValueRef llvm_build_intcast(LLVMValueRef X, LLVMTypeRef Ty,
1969                                          value Name, value B) {
1970   return LLVMBuildIntCast(Builder_val(B), X, Ty, String_val(Name));
1971 }
1972
1973 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1974 CAMLprim LLVMValueRef llvm_build_fpcast(LLVMValueRef X, LLVMTypeRef Ty,
1975                                         value Name, value B) {
1976   return LLVMBuildFPCast(Builder_val(B), X, Ty, String_val(Name));
1977 }
1978
1979 /*--... Comparisons ........................................................--*/
1980
1981 /* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1982 CAMLprim LLVMValueRef llvm_build_icmp(value Pred,
1983                                       LLVMValueRef LHS, LLVMValueRef RHS,
1984                                       value Name, value B) {
1985   return LLVMBuildICmp(Builder_val(B), Int_val(Pred) + LLVMIntEQ, LHS, RHS,
1986                        String_val(Name));
1987 }
1988
1989 /* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1990 CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
1991                                       LLVMValueRef LHS, LLVMValueRef RHS,
1992                                       value Name, value B) {
1993   return LLVMBuildFCmp(Builder_val(B), Int_val(Pred), LHS, RHS,
1994                        String_val(Name));
1995 }
1996
1997 /*--... Miscellaneous instructions .........................................--*/
1998
1999 /* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */
2000 CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
2001   value Hd, Tl;
2002   LLVMValueRef FirstValue, PhiNode;
2003   
2004   assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
2005   
2006   Hd = Field(Incoming, 0);
2007   FirstValue = (LLVMValueRef) Field(Hd, 0);
2008   PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
2009                          String_val(Name));
2010
2011   for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) {
2012     value Hd = Field(Tl, 0);
2013     LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
2014                     (LLVMBasicBlockRef*) &Field(Hd, 1), 1);
2015   }
2016   
2017   return PhiNode;
2018 }
2019
2020 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
2021 CAMLprim LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params,
2022                                       value Name, value B) {
2023   return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Params),
2024                        Wosize_val(Params), String_val(Name));
2025 }
2026
2027 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2028 CAMLprim LLVMValueRef llvm_build_select(LLVMValueRef If,
2029                                         LLVMValueRef Then, LLVMValueRef Else,
2030                                         value Name, value B) {
2031   return LLVMBuildSelect(Builder_val(B), If, Then, Else, String_val(Name));
2032 }
2033
2034 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2035 CAMLprim LLVMValueRef llvm_build_va_arg(LLVMValueRef List, LLVMTypeRef Ty,
2036                                         value Name, value B) {
2037   return LLVMBuildVAArg(Builder_val(B), List, Ty, String_val(Name));
2038 }
2039
2040 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2041 CAMLprim LLVMValueRef llvm_build_extractelement(LLVMValueRef Vec,
2042                                                 LLVMValueRef Idx,
2043                                                 value Name, value B) {
2044   return LLVMBuildExtractElement(Builder_val(B), Vec, Idx, String_val(Name));
2045 }
2046
2047 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2048 CAMLprim LLVMValueRef llvm_build_insertelement(LLVMValueRef Vec,
2049                                                LLVMValueRef Element,
2050                                                LLVMValueRef Idx,
2051                                                value Name, value B) {
2052   return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx, 
2053                                 String_val(Name));
2054 }
2055
2056 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2057 CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2,
2058                                                LLVMValueRef Mask,
2059                                                value Name, value B) {
2060   return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name));
2061 }
2062
2063 /* llvalue -> int -> string -> llbuilder -> llvalue */
2064 CAMLprim LLVMValueRef llvm_build_extractvalue(LLVMValueRef Aggregate,
2065                                               value Idx, value Name, value B) {
2066   return LLVMBuildExtractValue(Builder_val(B), Aggregate, Int_val(Idx),
2067                                String_val(Name));
2068 }
2069
2070 /* llvalue -> llvalue -> int -> string -> llbuilder -> llvalue */
2071 CAMLprim LLVMValueRef llvm_build_insertvalue(LLVMValueRef Aggregate,
2072                                              LLVMValueRef Val, value Idx,
2073                                              value Name, value B) {
2074   return LLVMBuildInsertValue(Builder_val(B), Aggregate, Val, Int_val(Idx),
2075                               String_val(Name));
2076 }
2077
2078 /* llvalue -> string -> llbuilder -> llvalue */
2079 CAMLprim LLVMValueRef llvm_build_is_null(LLVMValueRef Val, value Name,
2080                                          value B) {
2081   return LLVMBuildIsNull(Builder_val(B), Val, String_val(Name));
2082 }
2083
2084 /* llvalue -> string -> llbuilder -> llvalue */
2085 CAMLprim LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name,
2086                                              value B) {
2087   return LLVMBuildIsNotNull(Builder_val(B), Val, String_val(Name));
2088 }
2089
2090 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2091 CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS,
2092                                          value Name, value B) {
2093   return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name));
2094 }
2095
2096 /*===-- Memory buffers ----------------------------------------------------===*/
2097
2098 /* string -> llmemorybuffer
2099    raises IoError msg on error */
2100 CAMLprim value llvm_memorybuffer_of_file(value Path) {
2101   CAMLparam1(Path);
2102   char *Message;
2103   LLVMMemoryBufferRef MemBuf;
2104   
2105   if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path),
2106                                                &MemBuf, &Message))
2107     llvm_raise(llvm_ioerror_exn, Message);
2108   
2109   CAMLreturn((value) MemBuf);
2110 }
2111
2112 /* unit -> llmemorybuffer
2113    raises IoError msg on error */
2114 CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
2115   char *Message;
2116   LLVMMemoryBufferRef MemBuf;
2117   
2118   if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message))
2119     llvm_raise(llvm_ioerror_exn, Message);
2120   
2121   return MemBuf;
2122 }
2123
2124 /* ?name:string -> string -> llmemorybuffer */
2125 CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_string(value Name, value String) {
2126   const char *NameCStr;
2127   if(Name == Val_int(0))
2128     NameCStr = "";
2129   else
2130     NameCStr = String_val(Field(Name, 0));
2131
2132   LLVMMemoryBufferRef MemBuf;
2133   MemBuf = LLVMCreateMemoryBufferWithMemoryRangeCopy(
2134                 String_val(String), caml_string_length(String), NameCStr);
2135
2136   return MemBuf;
2137 }
2138
2139 /* llmemorybuffer -> string */
2140 CAMLprim value llvm_memorybuffer_as_string(LLVMMemoryBufferRef MemBuf) {
2141   value String = caml_alloc_string(LLVMGetBufferSize(MemBuf));
2142   memcpy(String_val(String), LLVMGetBufferStart(MemBuf),
2143          LLVMGetBufferSize(MemBuf));
2144
2145   return String;
2146 }
2147
2148 /* llmemorybuffer -> unit */
2149 CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) {
2150   LLVMDisposeMemoryBuffer(MemBuf);
2151   return Val_unit;
2152 }
2153
2154 /*===-- Pass Managers -----------------------------------------------------===*/
2155
2156 /* unit -> [ `Module ] PassManager.t */
2157 CAMLprim LLVMPassManagerRef llvm_passmanager_create(value Unit) {
2158   return LLVMCreatePassManager();
2159 }
2160
2161 /* llmodule -> [ `Function ] PassManager.t -> bool */
2162 CAMLprim value llvm_passmanager_run_module(LLVMModuleRef M,
2163                                            LLVMPassManagerRef PM) {
2164   return Val_bool(LLVMRunPassManager(PM, M));
2165 }
2166
2167 /* [ `Function ] PassManager.t -> bool */
2168 CAMLprim value llvm_passmanager_initialize(LLVMPassManagerRef FPM) {
2169   return Val_bool(LLVMInitializeFunctionPassManager(FPM));
2170 }
2171
2172 /* llvalue -> [ `Function ] PassManager.t -> bool */
2173 CAMLprim value llvm_passmanager_run_function(LLVMValueRef F,
2174                                              LLVMPassManagerRef FPM) {
2175   return Val_bool(LLVMRunFunctionPassManager(FPM, F));
2176 }
2177
2178 /* [ `Function ] PassManager.t -> bool */
2179 CAMLprim value llvm_passmanager_finalize(LLVMPassManagerRef FPM) {
2180   return Val_bool(LLVMFinalizeFunctionPassManager(FPM));
2181 }
2182
2183 /* PassManager.any PassManager.t -> unit */
2184 CAMLprim value llvm_passmanager_dispose(LLVMPassManagerRef PM) {
2185   LLVMDisposePassManager(PM);
2186   return Val_unit;
2187 }