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