bindings/ocaml/llvm/llvm_ocaml.c

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