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