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