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 -> Attribute.t -> unit */
1038 CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
1039   LLVMAddFunctionAttr(Arg, Int_val(PA));
1040   return Val_unit;
1041 }
1042
1043 /* llvalue -> Attribute.t -> unit */
1044 CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
1045   LLVMRemoveFunctionAttr(Arg, Int_val(PA));
1046   return Val_unit;
1047 }
1048 /*--... Operations on parameters ...........................................--*/
1049
1050 DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
1051
1052 /* llvalue -> int -> llvalue */
1053 CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
1054   return LLVMGetParam(Fn, Int_val(Index));
1055 }
1056
1057 /* llvalue -> llvalue */
1058 CAMLprim value llvm_params(LLVMValueRef Fn) {
1059   value Params = alloc(LLVMCountParams(Fn), 0);
1060   LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
1061   return Params;
1062 }
1063
1064 /* llvalue -> Attribute.t -> unit */
1065 CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
1066   LLVMAddAttribute(Arg, Int_val(PA));
1067   return Val_unit;
1068 }
1069
1070 /* llvalue -> Attribute.t -> unit */
1071 CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
1072   LLVMRemoveAttribute(Arg, Int_val(PA));
1073   return Val_unit;
1074 }
1075
1076 /* llvalue -> int -> unit */
1077 CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
1078   LLVMSetParamAlignment(Arg, Int_val(align));
1079   return Val_unit;
1080 }
1081
1082 /*--... Operations on basic blocks .........................................--*/
1083
1084 DEFINE_ITERATORS(
1085   block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
1086
1087 /* llvalue -> llbasicblock array */
1088 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
1089   value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
1090   LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
1091   return MLArray;
1092 }
1093
1094 /* llbasicblock -> unit */
1095 CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
1096   LLVMDeleteBasicBlock(BB);
1097   return Val_unit;
1098 }
1099
1100 /* string -> llvalue -> llbasicblock */
1101 CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
1102                                              LLVMValueRef Fn) {
1103   return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name));
1104 }
1105
1106 /* string -> llbasicblock -> llbasicblock */
1107 CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name,
1108                                              LLVMBasicBlockRef BB) {
1109   return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name));
1110 }
1111
1112 /* llvalue -> bool */
1113 CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
1114   return Val_bool(LLVMValueIsBasicBlock(Val));
1115 }
1116
1117 /*--... Operations on instructions .........................................--*/
1118
1119 DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
1120                  LLVMGetInstructionParent)
1121
1122 /* llvalue -> Opcode.t */
1123 CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
1124   LLVMOpcode o;
1125   if (!LLVMIsAInstruction(Inst))
1126       failwith("Not an instruction");
1127   o = LLVMGetInstructionOpcode(Inst);
1128   assert (o <= LLVMUnwind );
1129   return Val_int(o);
1130 }
1131
1132 /* llvalue -> ICmp.t */
1133 CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
1134   CAMLparam0();
1135   int x = LLVMGetICmpPredicate(Val);
1136   if (x) {
1137     value Option = alloc(1, 0);
1138     Field(Option, 0) = Val_int(x - LLVMIntEQ);
1139     CAMLreturn(Option);
1140   }
1141   CAMLreturn(Val_int(0));
1142 }
1143
1144
1145 /*--... Operations on call sites ...........................................--*/
1146
1147 /* llvalue -> int */
1148 CAMLprim value llvm_instruction_call_conv(LLVMValueRef Inst) {
1149   return Val_int(LLVMGetInstructionCallConv(Inst));
1150 }
1151
1152 /* int -> llvalue -> unit */
1153 CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
1154   LLVMSetInstructionCallConv(Inst, Int_val(CC));
1155   return Val_unit;
1156 }
1157
1158 /* llvalue -> int -> Attribute.t -> unit */
1159 CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
1160                                                value index,
1161                                                value PA) {
1162   LLVMAddInstrAttribute(Instr, Int_val(index), Int_val(PA));
1163   return Val_unit;
1164 }
1165
1166 /* llvalue -> int -> Attribute.t -> unit */
1167 CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
1168                                                   value index,
1169                                                   value PA) {
1170   LLVMRemoveInstrAttribute(Instr, Int_val(index), Int_val(PA));
1171   return Val_unit;
1172 }
1173
1174 /*--... Operations on call instructions (only) .............................--*/
1175
1176 /* llvalue -> bool */
1177 CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) {
1178   return Val_bool(LLVMIsTailCall(CallInst));
1179 }
1180
1181 /* bool -> llvalue -> unit */
1182 CAMLprim value llvm_set_tail_call(value IsTailCall,
1183                                   LLVMValueRef CallInst) {
1184   LLVMSetTailCall(CallInst, Bool_val(IsTailCall));
1185   return Val_unit;
1186 }
1187
1188 /*--... Operations on phi nodes ............................................--*/
1189
1190 /* (llvalue * llbasicblock) -> llvalue -> unit */
1191 CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
1192   LLVMAddIncoming(PhiNode,
1193                   (LLVMValueRef*) &Field(Incoming, 0),
1194                   (LLVMBasicBlockRef*) &Field(Incoming, 1),
1195                   1);
1196   return Val_unit;
1197 }
1198
1199 /* llvalue -> (llvalue * llbasicblock) list */
1200 CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
1201   unsigned I;
1202   CAMLparam0();
1203   CAMLlocal3(Hd, Tl, Tmp);
1204
1205   /* Build a tuple list of them. */
1206   Tl = Val_int(0);
1207   for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
1208     Hd = alloc(2, 0);
1209     Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
1210     Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
1211
1212     Tmp = alloc(2, 0);
1213     Store_field(Tmp, 0, Hd);
1214     Store_field(Tmp, 1, Tl);
1215     Tl = Tmp;
1216   }
1217
1218   CAMLreturn(Tl);
1219 }
1220
1221
1222 /*===-- Instruction builders ----------------------------------------------===*/
1223
1224 #define Builder_val(v)  (*(LLVMBuilderRef *)(Data_custom_val(v)))
1225
1226 static void llvm_finalize_builder(value B) {
1227   LLVMDisposeBuilder(Builder_val(B));
1228 }
1229
1230 static struct custom_operations builder_ops = {
1231   (char *) "IRBuilder",
1232   llvm_finalize_builder,
1233   custom_compare_default,
1234   custom_hash_default,
1235   custom_serialize_default,
1236   custom_deserialize_default
1237 };
1238
1239 static value alloc_builder(LLVMBuilderRef B) {
1240   value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
1241   Builder_val(V) = B;
1242   return V;
1243 }
1244
1245 /* llcontext -> llbuilder */
1246 CAMLprim value llvm_builder(LLVMContextRef C) {
1247   return alloc_builder(LLVMCreateBuilderInContext(C));
1248 }
1249
1250 /* (llbasicblock, llvalue) llpos -> llbuilder -> unit */
1251 CAMLprim value llvm_position_builder(value Pos, value B) {
1252   if (Tag_val(Pos) == 0) {
1253     LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0));
1254     LLVMPositionBuilderAtEnd(Builder_val(B), BB);
1255   } else {
1256     LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0));
1257     LLVMPositionBuilderBefore(Builder_val(B), I);
1258   }
1259   return Val_unit;
1260 }
1261
1262 /* llbuilder -> llbasicblock */
1263 CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) {
1264   LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
1265   if (!InsertBlock)
1266     raise_not_found();
1267   return InsertBlock;
1268 }
1269
1270 /* llvalue -> string -> llbuilder -> unit */
1271 CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) {
1272   LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name));
1273   return Val_unit;
1274 }
1275
1276 /*--... Metadata ...........................................................--*/
1277
1278 /* llbuilder -> llvalue -> unit */
1279 CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) {
1280   LLVMSetCurrentDebugLocation(Builder_val(B), V);
1281   return Val_unit;
1282 }
1283
1284 /* llbuilder -> unit */
1285 CAMLprim value llvm_clear_current_debug_location(value B) {
1286   LLVMSetCurrentDebugLocation(Builder_val(B), NULL);
1287   return Val_unit;
1288 }
1289
1290 /* llbuilder -> llvalue option */
1291 CAMLprim value llvm_current_debug_location(value B) {
1292   CAMLparam0();
1293   LLVMValueRef L;
1294   if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) {
1295     value Option = alloc(1, 0);
1296     Field(Option, 0) = (value) L;
1297     CAMLreturn(Option);
1298   }
1299   CAMLreturn(Val_int(0));
1300 }
1301
1302 /* llbuilder -> llvalue -> unit */
1303 CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) {
1304   LLVMSetInstDebugLocation(Builder_val(B), V);
1305   return Val_unit;
1306 }
1307
1308
1309 /*--... Terminators ........................................................--*/
1310
1311 /* llbuilder -> llvalue */
1312 CAMLprim LLVMValueRef llvm_build_ret_void(value B) {
1313   return LLVMBuildRetVoid(Builder_val(B));
1314 }
1315
1316 /* llvalue -> llbuilder -> llvalue */
1317 CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) {
1318   return LLVMBuildRet(Builder_val(B), Val);
1319 }
1320
1321 /* llvalue array -> llbuilder -> llvalue */
1322 CAMLprim LLVMValueRef llvm_build_aggregate_ret(value RetVals, value B) {
1323   return LLVMBuildAggregateRet(Builder_val(B), (LLVMValueRef *) Op_val(RetVals),
1324                                Wosize_val(RetVals));
1325 }
1326
1327 /* llbasicblock -> llbuilder -> llvalue */
1328 CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) {
1329   return LLVMBuildBr(Builder_val(B), BB);
1330 }
1331
1332 /* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */
1333 CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If,
1334                                          LLVMBasicBlockRef Then,
1335                                          LLVMBasicBlockRef Else,
1336                                          value B) {
1337   return LLVMBuildCondBr(Builder_val(B), If, Then, Else);
1338 }
1339
1340 /* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */
1341 CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
1342                                         LLVMBasicBlockRef Else,
1343                                         value EstimatedCount,
1344                                         value B) {
1345   return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
1346 }
1347
1348 /* llvalue -> llvalue -> llbasicblock -> unit */
1349 CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
1350                              LLVMBasicBlockRef Dest) {
1351   LLVMAddCase(Switch, OnVal, Dest);
1352   return Val_unit;
1353 }
1354
1355 /* llvalue -> llbasicblock -> llbuilder -> llvalue */
1356 CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr,
1357                                              value EstimatedDests,
1358                                              value B) {
1359   return LLVMBuildIndirectBr(Builder_val(B), Addr, EstimatedDests);
1360 }
1361
1362 /* llvalue -> llvalue -> llbasicblock -> unit */
1363 CAMLprim value llvm_add_destination(LLVMValueRef IndirectBr,
1364                                     LLVMBasicBlockRef Dest) {
1365   LLVMAddDestination(IndirectBr, Dest);
1366   return Val_unit;
1367 }
1368
1369 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1370    llbuilder -> llvalue */
1371 CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
1372                                             LLVMBasicBlockRef Then,
1373                                             LLVMBasicBlockRef Catch,
1374                                             value Name, value B) {
1375   return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Args),
1376                          Wosize_val(Args), Then, Catch, String_val(Name));
1377 }
1378
1379 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1380    llbuilder -> llvalue */
1381 CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
1382   return llvm_build_invoke_nat((LLVMValueRef) Args[0], Args[1],
1383                                (LLVMBasicBlockRef) Args[2],
1384                                (LLVMBasicBlockRef) Args[3],
1385                                Args[4], Args[5]);
1386 }
1387
1388 CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
1389                                             value NumClauses,  value Name,
1390                                             value B) {
1391     return LLVMBuildLandingPad(Builder_val(B), Ty, PersFn, Int_val(NumClauses),
1392                                String_val(Name));
1393 }
1394
1395 CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
1396 {
1397     LLVMSetCleanup(LandingPadInst, Bool_val(flag));
1398     return Val_unit;
1399 }
1400
1401 /* llbuilder -> llvalue */
1402 CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
1403   return LLVMBuildUnreachable(Builder_val(B));
1404 }
1405
1406 /*--... Arithmetic .........................................................--*/
1407
1408 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1409 CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS,
1410                                      value Name, value B) {
1411   return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name));
1412 }
1413
1414 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1415 CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1416                                          value Name, value B) {
1417   return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1418 }
1419
1420 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1421 CAMLprim LLVMValueRef llvm_build_nuw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1422                                          value Name, value B) {
1423   return LLVMBuildNUWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1424 }
1425
1426 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1427 CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS,
1428                                       value Name, value B) {
1429   return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name));
1430 }
1431
1432 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1433 CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1434                                      value Name, value B) {
1435   return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name));
1436 }
1437
1438 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1439 CAMLprim LLVMValueRef llvm_build_nsw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1440                                          value Name, value B) {
1441   return LLVMBuildNSWSub(Builder_val(B), LHS, RHS, String_val(Name));
1442 }
1443
1444 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1445 CAMLprim LLVMValueRef llvm_build_nuw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1446                                          value Name, value B) {
1447   return LLVMBuildNUWSub(Builder_val(B), LHS, RHS, String_val(Name));
1448 }
1449
1450 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1451 CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS,
1452                                       value Name, value B) {
1453   return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name));
1454 }
1455
1456 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1457 CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1458                                      value Name, value B) {
1459   return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name));
1460 }
1461
1462 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1463 CAMLprim LLVMValueRef llvm_build_nsw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1464                                          value Name, value B) {
1465   return LLVMBuildNSWMul(Builder_val(B), LHS, RHS, String_val(Name));
1466 }
1467
1468 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1469 CAMLprim LLVMValueRef llvm_build_nuw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1470                                          value Name, value B) {
1471   return LLVMBuildNUWMul(Builder_val(B), LHS, RHS, String_val(Name));
1472 }
1473
1474 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1475 CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS,
1476                                       value Name, value B) {
1477   return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name));
1478 }
1479
1480 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1481 CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS,
1482                                       value Name, value B) {
1483   return LLVMBuildUDiv(Builder_val(B), LHS, RHS, String_val(Name));
1484 }
1485
1486 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1487 CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1488                                       value Name, value B) {
1489   return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1490 }
1491
1492 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1493 CAMLprim LLVMValueRef llvm_build_exact_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1494                                             value Name, value B) {
1495   return LLVMBuildExactSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1496 }
1497
1498 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1499 CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1500                                       value Name, value B) {
1501   return LLVMBuildFDiv(Builder_val(B), LHS, RHS, String_val(Name));
1502 }
1503
1504 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1505 CAMLprim LLVMValueRef llvm_build_urem(LLVMValueRef LHS, LLVMValueRef RHS,
1506                                       value Name, value B) {
1507   return LLVMBuildURem(Builder_val(B), LHS, RHS, String_val(Name));
1508 }
1509
1510 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1511 CAMLprim LLVMValueRef llvm_build_srem(LLVMValueRef LHS, LLVMValueRef RHS,
1512                                       value Name, value B) {
1513   return LLVMBuildSRem(Builder_val(B), LHS, RHS, String_val(Name));
1514 }
1515
1516 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1517 CAMLprim LLVMValueRef llvm_build_frem(LLVMValueRef LHS, LLVMValueRef RHS,
1518                                       value Name, value B) {
1519   return LLVMBuildFRem(Builder_val(B), LHS, RHS, String_val(Name));
1520 }
1521
1522 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1523 CAMLprim LLVMValueRef llvm_build_shl(LLVMValueRef LHS, LLVMValueRef RHS,
1524                                      value Name, value B) {
1525   return LLVMBuildShl(Builder_val(B), LHS, RHS, String_val(Name));
1526 }
1527
1528 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1529 CAMLprim LLVMValueRef llvm_build_lshr(LLVMValueRef LHS, LLVMValueRef RHS,
1530                                       value Name, value B) {
1531   return LLVMBuildLShr(Builder_val(B), LHS, RHS, String_val(Name));
1532 }
1533
1534 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1535 CAMLprim LLVMValueRef llvm_build_ashr(LLVMValueRef LHS, LLVMValueRef RHS,
1536                                       value Name, value B) {
1537   return LLVMBuildAShr(Builder_val(B), LHS, RHS, String_val(Name));
1538 }
1539
1540 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1541 CAMLprim LLVMValueRef llvm_build_and(LLVMValueRef LHS, LLVMValueRef RHS,
1542                                      value Name, value B) {
1543   return LLVMBuildAnd(Builder_val(B), LHS, RHS, String_val(Name));
1544 }
1545
1546 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1547 CAMLprim LLVMValueRef llvm_build_or(LLVMValueRef LHS, LLVMValueRef RHS,
1548                                     value Name, value B) {
1549   return LLVMBuildOr(Builder_val(B), LHS, RHS, String_val(Name));
1550 }
1551
1552 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1553 CAMLprim LLVMValueRef llvm_build_xor(LLVMValueRef LHS, LLVMValueRef RHS,
1554                                      value Name, value B) {
1555   return LLVMBuildXor(Builder_val(B), LHS, RHS, String_val(Name));
1556 }
1557
1558 /* llvalue -> string -> llbuilder -> llvalue */
1559 CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X,
1560                                      value Name, value B) {
1561   return LLVMBuildNeg(Builder_val(B), X, String_val(Name));
1562 }
1563
1564 /* llvalue -> string -> llbuilder -> llvalue */
1565 CAMLprim LLVMValueRef llvm_build_nsw_neg(LLVMValueRef X,
1566                                          value Name, value B) {
1567   return LLVMBuildNSWNeg(Builder_val(B), X, String_val(Name));
1568 }
1569
1570 /* llvalue -> string -> llbuilder -> llvalue */
1571 CAMLprim LLVMValueRef llvm_build_nuw_neg(LLVMValueRef X,
1572                                          value Name, value B) {
1573   return LLVMBuildNUWNeg(Builder_val(B), X, String_val(Name));
1574 }
1575
1576 /* llvalue -> string -> llbuilder -> llvalue */
1577 CAMLprim LLVMValueRef llvm_build_fneg(LLVMValueRef X,
1578                                      value Name, value B) {
1579   return LLVMBuildFNeg(Builder_val(B), X, String_val(Name));
1580 }
1581
1582 /* llvalue -> string -> llbuilder -> llvalue */
1583 CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X,
1584                                      value Name, value B) {
1585   return LLVMBuildNot(Builder_val(B), X, String_val(Name));
1586 }
1587
1588 /*--... Memory .............................................................--*/
1589
1590 /* lltype -> string -> llbuilder -> llvalue */
1591 CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty,
1592                                         value Name, value B) {
1593   return LLVMBuildAlloca(Builder_val(B), Ty, String_val(Name));
1594 }
1595
1596 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
1597 CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size,
1598                                               value Name, value B) {
1599   return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name));
1600 }
1601
1602 /* llvalue -> string -> llbuilder -> llvalue */
1603 CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer,
1604                                       value Name, value B) {
1605   return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name));
1606 }
1607
1608 /* llvalue -> llvalue -> llbuilder -> llvalue */
1609 CAMLprim LLVMValueRef llvm_build_store(LLVMValueRef Value, LLVMValueRef Pointer,
1610                                        value B) {
1611   return LLVMBuildStore(Builder_val(B), Value, Pointer);
1612 }
1613
1614 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1615 CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices,
1616                                      value Name, value B) {
1617   return LLVMBuildGEP(Builder_val(B), Pointer,
1618                       (LLVMValueRef *) Op_val(Indices), Wosize_val(Indices),
1619                       String_val(Name));
1620 }
1621
1622 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1623 CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer,
1624                                                value Indices, value Name,
1625                                                value B) {
1626   return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
1627                               (LLVMValueRef *) Op_val(Indices),
1628                               Wosize_val(Indices), String_val(Name));
1629 }
1630
1631 /* llvalue -> int -> string -> llbuilder -> llvalue */
1632 CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer,
1633                                                value Index, value Name,
1634                                                value B) {
1635   return LLVMBuildStructGEP(Builder_val(B), Pointer,
1636                               Int_val(Index), String_val(Name));
1637 }
1638
1639 /* string -> string -> llbuilder -> llvalue */
1640 CAMLprim LLVMValueRef llvm_build_global_string(value Str, value Name, value B) {
1641   return LLVMBuildGlobalString(Builder_val(B), String_val(Str),
1642                                String_val(Name));
1643 }
1644
1645 /* string -> string -> llbuilder -> llvalue */
1646 CAMLprim LLVMValueRef llvm_build_global_stringptr(value Str, value Name,
1647                                                   value B) {
1648   return LLVMBuildGlobalStringPtr(Builder_val(B), String_val(Str),
1649                                   String_val(Name));
1650 }
1651
1652 /*--... Casts ..............................................................--*/
1653
1654 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1655 CAMLprim LLVMValueRef llvm_build_trunc(LLVMValueRef X, LLVMTypeRef Ty,
1656                                        value Name, value B) {
1657   return LLVMBuildTrunc(Builder_val(B), X, Ty, String_val(Name));
1658 }
1659
1660 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1661 CAMLprim LLVMValueRef llvm_build_zext(LLVMValueRef X, LLVMTypeRef Ty,
1662                                       value Name, value B) {
1663   return LLVMBuildZExt(Builder_val(B), X, Ty, String_val(Name));
1664 }
1665
1666 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1667 CAMLprim LLVMValueRef llvm_build_sext(LLVMValueRef X, LLVMTypeRef Ty,
1668                                       value Name, value B) {
1669   return LLVMBuildSExt(Builder_val(B), X, Ty, String_val(Name));
1670 }
1671
1672 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1673 CAMLprim LLVMValueRef llvm_build_fptoui(LLVMValueRef X, LLVMTypeRef Ty,
1674                                         value Name, value B) {
1675   return LLVMBuildFPToUI(Builder_val(B), X, Ty, String_val(Name));
1676 }
1677
1678 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1679 CAMLprim LLVMValueRef llvm_build_fptosi(LLVMValueRef X, LLVMTypeRef Ty,
1680                                         value Name, value B) {
1681   return LLVMBuildFPToSI(Builder_val(B), X, Ty, String_val(Name));
1682 }
1683
1684 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1685 CAMLprim LLVMValueRef llvm_build_uitofp(LLVMValueRef X, LLVMTypeRef Ty,
1686                                         value Name, value B) {
1687   return LLVMBuildUIToFP(Builder_val(B), X, Ty, String_val(Name));
1688 }
1689
1690 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1691 CAMLprim LLVMValueRef llvm_build_sitofp(LLVMValueRef X, LLVMTypeRef Ty,
1692                                         value Name, value B) {
1693   return LLVMBuildSIToFP(Builder_val(B), X, Ty, String_val(Name));
1694 }
1695
1696 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1697 CAMLprim LLVMValueRef llvm_build_fptrunc(LLVMValueRef X, LLVMTypeRef Ty,
1698                                          value Name, value B) {
1699   return LLVMBuildFPTrunc(Builder_val(B), X, Ty, String_val(Name));
1700 }
1701
1702 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1703 CAMLprim LLVMValueRef llvm_build_fpext(LLVMValueRef X, LLVMTypeRef Ty,
1704                                        value Name, value B) {
1705   return LLVMBuildFPExt(Builder_val(B), X, Ty, String_val(Name));
1706 }
1707
1708 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1709 CAMLprim LLVMValueRef llvm_build_prttoint(LLVMValueRef X, LLVMTypeRef Ty,
1710                                           value Name, value B) {
1711   return LLVMBuildPtrToInt(Builder_val(B), X, Ty, String_val(Name));
1712 }
1713
1714 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1715 CAMLprim LLVMValueRef llvm_build_inttoptr(LLVMValueRef X, LLVMTypeRef Ty,
1716                                           value Name, value B) {
1717   return LLVMBuildIntToPtr(Builder_val(B), X, Ty, String_val(Name));
1718 }
1719
1720 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1721 CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1722                                          value Name, value B) {
1723   return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name));
1724 }
1725
1726 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1727 CAMLprim LLVMValueRef llvm_build_zext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1728                                                  value Name, value B) {
1729   return LLVMBuildZExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1730 }
1731
1732 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1733 CAMLprim LLVMValueRef llvm_build_sext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1734                                                  value Name, value B) {
1735   return LLVMBuildSExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1736 }
1737
1738 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1739 CAMLprim LLVMValueRef llvm_build_trunc_or_bitcast(LLVMValueRef X,
1740                                                   LLVMTypeRef Ty, value Name,
1741                                                   value B) {
1742   return LLVMBuildTruncOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1743 }
1744
1745 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1746 CAMLprim LLVMValueRef llvm_build_pointercast(LLVMValueRef X, LLVMTypeRef Ty,
1747                                              value Name, value B) {
1748   return LLVMBuildPointerCast(Builder_val(B), X, Ty, String_val(Name));
1749 }
1750
1751 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1752 CAMLprim LLVMValueRef llvm_build_intcast(LLVMValueRef X, LLVMTypeRef Ty,
1753                                          value Name, value B) {
1754   return LLVMBuildIntCast(Builder_val(B), X, Ty, String_val(Name));
1755 }
1756
1757 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1758 CAMLprim LLVMValueRef llvm_build_fpcast(LLVMValueRef X, LLVMTypeRef Ty,
1759                                         value Name, value B) {
1760   return LLVMBuildFPCast(Builder_val(B), X, Ty, String_val(Name));
1761 }
1762
1763 /*--... Comparisons ........................................................--*/
1764
1765 /* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1766 CAMLprim LLVMValueRef llvm_build_icmp(value Pred,
1767                                       LLVMValueRef LHS, LLVMValueRef RHS,
1768                                       value Name, value B) {
1769   return LLVMBuildICmp(Builder_val(B), Int_val(Pred) + LLVMIntEQ, LHS, RHS,
1770                        String_val(Name));
1771 }
1772
1773 /* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1774 CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
1775                                       LLVMValueRef LHS, LLVMValueRef RHS,
1776                                       value Name, value B) {
1777   return LLVMBuildFCmp(Builder_val(B), Int_val(Pred), LHS, RHS,
1778                        String_val(Name));
1779 }
1780
1781 /*--... Miscellaneous instructions .........................................--*/
1782
1783 /* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */
1784 CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
1785   value Hd, Tl;
1786   LLVMValueRef FirstValue, PhiNode;
1787
1788   assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
1789
1790   Hd = Field(Incoming, 0);
1791   FirstValue = (LLVMValueRef) Field(Hd, 0);
1792   PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
1793                          String_val(Name));
1794
1795   for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) {
1796     value Hd = Field(Tl, 0);
1797     LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
1798                     (LLVMBasicBlockRef*) &Field(Hd, 1), 1);
1799   }
1800
1801   return PhiNode;
1802 }
1803
1804 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1805 CAMLprim LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params,
1806                                       value Name, value B) {
1807   return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Params),
1808                        Wosize_val(Params), String_val(Name));
1809 }
1810
1811 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1812 CAMLprim LLVMValueRef llvm_build_select(LLVMValueRef If,
1813                                         LLVMValueRef Then, LLVMValueRef Else,
1814                                         value Name, value B) {
1815   return LLVMBuildSelect(Builder_val(B), If, Then, Else, String_val(Name));
1816 }
1817
1818 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1819 CAMLprim LLVMValueRef llvm_build_va_arg(LLVMValueRef List, LLVMTypeRef Ty,
1820                                         value Name, value B) {
1821   return LLVMBuildVAArg(Builder_val(B), List, Ty, String_val(Name));
1822 }
1823
1824 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1825 CAMLprim LLVMValueRef llvm_build_extractelement(LLVMValueRef Vec,
1826                                                 LLVMValueRef Idx,
1827                                                 value Name, value B) {
1828   return LLVMBuildExtractElement(Builder_val(B), Vec, Idx, String_val(Name));
1829 }
1830
1831 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1832 CAMLprim LLVMValueRef llvm_build_insertelement(LLVMValueRef Vec,
1833                                                LLVMValueRef Element,
1834                                                LLVMValueRef Idx,
1835                                                value Name, value B) {
1836   return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx,
1837                                 String_val(Name));
1838 }
1839
1840 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1841 CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2,
1842                                                LLVMValueRef Mask,
1843                                                value Name, value B) {
1844   return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name));
1845 }
1846
1847 /* llvalue -> int -> string -> llbuilder -> llvalue */
1848 CAMLprim LLVMValueRef llvm_build_extractvalue(LLVMValueRef Aggregate,
1849                                               value Idx, value Name, value B) {
1850   return LLVMBuildExtractValue(Builder_val(B), Aggregate, Int_val(Idx),
1851                                String_val(Name));
1852 }
1853
1854 /* llvalue -> llvalue -> int -> string -> llbuilder -> llvalue */
1855 CAMLprim LLVMValueRef llvm_build_insertvalue(LLVMValueRef Aggregate,
1856                                              LLVMValueRef Val, value Idx,
1857                                              value Name, value B) {
1858   return LLVMBuildInsertValue(Builder_val(B), Aggregate, Val, Int_val(Idx),
1859                               String_val(Name));
1860 }
1861
1862 /* llvalue -> string -> llbuilder -> llvalue */
1863 CAMLprim LLVMValueRef llvm_build_is_null(LLVMValueRef Val, value Name,
1864                                          value B) {
1865   return LLVMBuildIsNull(Builder_val(B), Val, String_val(Name));
1866 }
1867
1868 /* llvalue -> string -> llbuilder -> llvalue */
1869 CAMLprim LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name,
1870                                              value B) {
1871   return LLVMBuildIsNotNull(Builder_val(B), Val, String_val(Name));
1872 }
1873
1874 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1875 CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS,
1876                                          value Name, value B) {
1877   return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name));
1878 }
1879
1880
1881 /*===-- Memory buffers ----------------------------------------------------===*/
1882
1883 /* string -> llmemorybuffer
1884    raises IoError msg on error */
1885 CAMLprim value llvm_memorybuffer_of_file(value Path) {
1886   CAMLparam1(Path);
1887   char *Message;
1888   LLVMMemoryBufferRef MemBuf;
1889
1890   if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path),
1891                                                &MemBuf, &Message))
1892     llvm_raise(llvm_ioerror_exn, Message);
1893
1894   CAMLreturn((value) MemBuf);
1895 }
1896
1897 /* unit -> llmemorybuffer
1898    raises IoError msg on error */
1899 CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
1900   char *Message;
1901   LLVMMemoryBufferRef MemBuf;
1902
1903   if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message))
1904     llvm_raise(llvm_ioerror_exn, Message);
1905
1906   return MemBuf;
1907 }
1908
1909 /* llmemorybuffer -> unit */
1910 CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) {
1911   LLVMDisposeMemoryBuffer(MemBuf);
1912   return Val_unit;
1913 }
1914
1915 /*===-- Pass Managers -----------------------------------------------------===*/
1916
1917 /* unit -> [ `Module ] PassManager.t */
1918 CAMLprim LLVMPassManagerRef llvm_passmanager_create(value Unit) {
1919   return LLVMCreatePassManager();
1920 }
1921
1922 /* llmodule -> [ `Function ] PassManager.t -> bool */
1923 CAMLprim value llvm_passmanager_run_module(LLVMModuleRef M,
1924                                            LLVMPassManagerRef PM) {
1925   return Val_bool(LLVMRunPassManager(PM, M));
1926 }
1927
1928 /* [ `Function ] PassManager.t -> bool */
1929 CAMLprim value llvm_passmanager_initialize(LLVMPassManagerRef FPM) {
1930   return Val_bool(LLVMInitializeFunctionPassManager(FPM));
1931 }
1932
1933 /* llvalue -> [ `Function ] PassManager.t -> bool */
1934 CAMLprim value llvm_passmanager_run_function(LLVMValueRef F,
1935                                              LLVMPassManagerRef FPM) {
1936   return Val_bool(LLVMRunFunctionPassManager(FPM, F));
1937 }
1938
1939 /* [ `Function ] PassManager.t -> bool */
1940 CAMLprim value llvm_passmanager_finalize(LLVMPassManagerRef FPM) {
1941   return Val_bool(LLVMFinalizeFunctionPassManager(FPM));
1942 }
1943
1944 /* PassManager.any PassManager.t -> unit */
1945 CAMLprim value llvm_passmanager_dispose(LLVMPassManagerRef PM) {
1946   LLVMDisposePassManager(PM);
1947   return Val_unit;
1948 }