bindings/ocaml/llvm/llvm_ocaml.c

   1 /*===-- llvm_ocaml.c - LLVM OCaml Glue --------------------------*- C++ -*-===*\
   2 |*                                                                            *|
   3 |* Part of the LLVM Project, under the Apache License v2.0 with LLVM          *|
   4 |* Exceptions.                                                                *|
   5 |* See https://llvm.org/LICENSE.txt for license information.                  *|
   6 |* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception                    *|
   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 <assert.h>
  19 #include <stdlib.h>
  20 #include <string.h>
  21 #include "llvm-c/Core.h"
  22 #include "llvm-c/Support.h"
  23 #include "llvm/Config/llvm-config.h"
  24 #include "caml/alloc.h"
  25 #include "caml/custom.h"
  26 #include "caml/memory.h"
  27 #include "caml/fail.h"
  28 #include "caml/callback.h"
  29
  30 value llvm_string_of_message(char* Message) {
  31   value String = caml_copy_string(Message);
  32   LLVMDisposeMessage(Message);
  33
  34   return String;
  35 }
  36
  37 void llvm_raise(value Prototype, char *Message) {
  38   CAMLparam1(Prototype);
  39   caml_raise_with_arg(Prototype, llvm_string_of_message(Message));
  40   CAMLnoreturn;
  41 }
  42
  43 static value llvm_fatal_error_handler;
  44
  45 static void llvm_fatal_error_trampoline(const char *Reason) {
  46   callback(llvm_fatal_error_handler, caml_copy_string(Reason));
  47 }
  48
  49 CAMLprim value llvm_install_fatal_error_handler(value Handler) {
  50   LLVMInstallFatalErrorHandler(llvm_fatal_error_trampoline);
  51   llvm_fatal_error_handler = Handler;
  52   caml_register_global_root(&llvm_fatal_error_handler);
  53   return Val_unit;
  54 }
  55
  56 CAMLprim value llvm_reset_fatal_error_handler(value Unit) {
  57   caml_remove_global_root(&llvm_fatal_error_handler);
  58   LLVMResetFatalErrorHandler();
  59   return Val_unit;
  60 }
  61
  62 CAMLprim value llvm_enable_pretty_stacktrace(value Unit) {
  63   LLVMEnablePrettyStackTrace();
  64   return Val_unit;
  65 }
  66
  67 CAMLprim value llvm_parse_command_line_options(value Overview, value Args) {
  68   char *COverview;
  69   if (Overview == Val_int(0)) {
  70     COverview = NULL;
  71   } else {
  72     COverview = String_val(Field(Overview, 0));
  73   }
  74   LLVMParseCommandLineOptions(Wosize_val(Args), (const char* const*) Op_val(Args), COverview);
  75   return Val_unit;
  76 }
  77
  78 static value alloc_variant(int tag, void *Value) {
  79   value Iter = alloc_small(1, tag);
  80   Field(Iter, 0) = Val_op(Value);
  81   return Iter;
  82 }
  83
  84 /* Macro to convert the C first/next/last/prev idiom to the Ocaml llpos/
  85    llrev_pos idiom. */
  86 #define DEFINE_ITERATORS(camlname, cname, pty, cty, pfun) \
  87   /* llmodule -> ('a, 'b) llpos */                        \
  88   CAMLprim value llvm_##camlname##_begin(pty Mom) {       \
  89     cty First = LLVMGetFirst##cname(Mom);                 \
  90     if (First)                                            \
  91       return alloc_variant(1, First);                     \
  92     return alloc_variant(0, Mom);                         \
  93   }                                                       \
  94                                                           \
  95   /* llvalue -> ('a, 'b) llpos */                         \
  96   CAMLprim value llvm_##camlname##_succ(cty Kid) {        \
  97     cty Next = LLVMGetNext##cname(Kid);                   \
  98     if (Next)                                             \
  99       return alloc_variant(1, Next);                      \
 100     return alloc_variant(0, pfun(Kid));                   \
 101   }                                                       \
 102                                                           \
 103   /* llmodule -> ('a, 'b) llrev_pos */                    \
 104   CAMLprim value llvm_##camlname##_end(pty Mom) {         \
 105     cty Last = LLVMGetLast##cname(Mom);                   \
 106     if (Last)                                             \
 107       return alloc_variant(1, Last);                      \
 108     return alloc_variant(0, Mom);                         \
 109   }                                                       \
 110                                                           \
 111   /* llvalue -> ('a, 'b) llrev_pos */                     \
 112   CAMLprim value llvm_##camlname##_pred(cty Kid) {        \
 113     cty Prev = LLVMGetPrevious##cname(Kid);               \
 114     if (Prev)                                             \
 115       return alloc_variant(1, Prev);                      \
 116     return alloc_variant(0, pfun(Kid));                   \
 117   }
 118
 119 /*===-- Context error handling --------------------------------------------===*/
 120
 121 void llvm_diagnostic_handler_trampoline(LLVMDiagnosticInfoRef DI,
 122                                         void *DiagnosticContext) {
 123   caml_callback(*((value *)DiagnosticContext), (value)DI);
 124 }
 125
 126 /* Diagnostic.t -> string */
 127 CAMLprim value llvm_get_diagnostic_description(value Diagnostic) {
 128   return llvm_string_of_message(
 129       LLVMGetDiagInfoDescription((LLVMDiagnosticInfoRef)Diagnostic));
 130 }
 131
 132 /* Diagnostic.t -> DiagnosticSeverity.t */
 133 CAMLprim value llvm_get_diagnostic_severity(value Diagnostic) {
 134   return Val_int(LLVMGetDiagInfoSeverity((LLVMDiagnosticInfoRef)Diagnostic));
 135 }
 136
 137 static void llvm_remove_diagnostic_handler(LLVMContextRef C) {
 138   if (LLVMContextGetDiagnosticHandler(C) ==
 139       llvm_diagnostic_handler_trampoline) {
 140     value *Handler = (value *)LLVMContextGetDiagnosticContext(C);
 141     remove_global_root(Handler);
 142     free(Handler);
 143   }
 144 }
 145
 146 /* llcontext -> (Diagnostic.t -> unit) option -> unit */
 147 CAMLprim value llvm_set_diagnostic_handler(LLVMContextRef C, value Handler) {
 148   llvm_remove_diagnostic_handler(C);
 149   if (Handler == Val_int(0)) {
 150     LLVMContextSetDiagnosticHandler(C, NULL, NULL);
 151   } else {
 152     value *DiagnosticContext = malloc(sizeof(value));
 153     if (DiagnosticContext == NULL)
 154       caml_raise_out_of_memory();
 155     caml_register_global_root(DiagnosticContext);
 156     *DiagnosticContext = Field(Handler, 0);
 157     LLVMContextSetDiagnosticHandler(C, llvm_diagnostic_handler_trampoline,
 158                                     DiagnosticContext);
 159   }
 160   return Val_unit;
 161 }
 162
 163 /*===-- Contexts ----------------------------------------------------------===*/
 164
 165 /* unit -> llcontext */
 166 CAMLprim LLVMContextRef llvm_create_context(value Unit) {
 167   return LLVMContextCreate();
 168 }
 169
 170 /* llcontext -> unit */
 171 CAMLprim value llvm_dispose_context(LLVMContextRef C) {
 172   llvm_remove_diagnostic_handler(C);
 173   LLVMContextDispose(C);
 174   return Val_unit;
 175 }
 176
 177 /* unit -> llcontext */
 178 CAMLprim LLVMContextRef llvm_global_context(value Unit) {
 179   return LLVMGetGlobalContext();
 180 }
 181
 182 /* llcontext -> string -> int */
 183 CAMLprim value llvm_mdkind_id(LLVMContextRef C, value Name) {
 184   unsigned MDKindID = LLVMGetMDKindIDInContext(C, String_val(Name),
 185                                                caml_string_length(Name));
 186   return Val_int(MDKindID);
 187 }
 188
 189 /*===-- Attributes --------------------------------------------------------===*/
 190
 191 /* string -> llattrkind */
 192 CAMLprim value llvm_enum_attr_kind(value Name) {
 193   unsigned Kind = LLVMGetEnumAttributeKindForName(
 194                         String_val(Name), caml_string_length(Name));
 195   if(Kind == 0)
 196     caml_raise_with_arg(*caml_named_value("Llvm.UnknownAttribute"), Name);
 197   return Val_int(Kind);
 198 }
 199
 200 /* llcontext -> int -> int64 -> llattribute */
 201 CAMLprim LLVMAttributeRef
 202 llvm_create_enum_attr_by_kind(LLVMContextRef C, value Kind, value Value) {
 203   return LLVMCreateEnumAttribute(C, Int_val(Kind), Int64_val(Value));
 204 }
 205
 206 /* llattribute -> bool */
 207 CAMLprim value llvm_is_enum_attr(LLVMAttributeRef A) {
 208   return Val_int(LLVMIsEnumAttribute(A));
 209 }
 210
 211 /* llattribute -> llattrkind */
 212 CAMLprim value llvm_get_enum_attr_kind(LLVMAttributeRef A) {
 213   return Val_int(LLVMGetEnumAttributeKind(A));
 214 }
 215
 216 /* llattribute -> int64 */
 217 CAMLprim value llvm_get_enum_attr_value(LLVMAttributeRef A) {
 218   return caml_copy_int64(LLVMGetEnumAttributeValue(A));
 219 }
 220
 221 /* llcontext -> kind:string -> name:string -> llattribute */
 222 CAMLprim LLVMAttributeRef llvm_create_string_attr(LLVMContextRef C,
 223                                                   value Kind, value Value) {
 224   return LLVMCreateStringAttribute(C,
 225                         String_val(Kind), caml_string_length(Kind),
 226                         String_val(Value), caml_string_length(Value));
 227 }
 228
 229 /* llattribute -> bool */
 230 CAMLprim value llvm_is_string_attr(LLVMAttributeRef A) {
 231   return Val_int(LLVMIsStringAttribute(A));
 232 }
 233
 234 /* llattribute -> string */
 235 CAMLprim value llvm_get_string_attr_kind(LLVMAttributeRef A) {
 236   unsigned Length;
 237   const char *String = LLVMGetStringAttributeKind(A, &Length);
 238   value Result = caml_alloc_string(Length);
 239   memcpy(String_val(Result), String, Length);
 240   return Result;
 241 }
 242
 243 /* llattribute -> string */
 244 CAMLprim value llvm_get_string_attr_value(LLVMAttributeRef A) {
 245   unsigned Length;
 246   const char *String = LLVMGetStringAttributeValue(A, &Length);
 247   value Result = caml_alloc_string(Length);
 248   memcpy(String_val(Result), String, Length);
 249   return Result;
 250 }
 251
 252 /*===-- Modules -----------------------------------------------------------===*/
 253
 254 /* llcontext -> string -> llmodule */
 255 CAMLprim LLVMModuleRef llvm_create_module(LLVMContextRef C, value ModuleID) {
 256   return LLVMModuleCreateWithNameInContext(String_val(ModuleID), C);
 257 }
 258
 259 /* llmodule -> unit */
 260 CAMLprim value llvm_dispose_module(LLVMModuleRef M) {
 261   LLVMDisposeModule(M);
 262   return Val_unit;
 263 }
 264
 265 /* llmodule -> string */
 266 CAMLprim value llvm_target_triple(LLVMModuleRef M) {
 267   return caml_copy_string(LLVMGetTarget(M));
 268 }
 269
 270 /* string -> llmodule -> unit */
 271 CAMLprim value llvm_set_target_triple(value Trip, LLVMModuleRef M) {
 272   LLVMSetTarget(M, String_val(Trip));
 273   return Val_unit;
 274 }
 275
 276 /* llmodule -> string */
 277 CAMLprim value llvm_data_layout(LLVMModuleRef M) {
 278   return caml_copy_string(LLVMGetDataLayout(M));
 279 }
 280
 281 /* string -> llmodule -> unit */
 282 CAMLprim value llvm_set_data_layout(value Layout, LLVMModuleRef M) {
 283   LLVMSetDataLayout(M, String_val(Layout));
 284   return Val_unit;
 285 }
 286
 287 /* llmodule -> unit */
 288 CAMLprim value llvm_dump_module(LLVMModuleRef M) {
 289   LLVMDumpModule(M);
 290   return Val_unit;
 291 }
 292
 293 /* string -> llmodule -> unit */
 294 CAMLprim value llvm_print_module(value Filename, LLVMModuleRef M) {
 295   char* Message;
 296
 297   if(LLVMPrintModuleToFile(M, String_val(Filename), &Message))
 298     llvm_raise(*caml_named_value("Llvm.IoError"), Message);
 299
 300   return Val_unit;
 301 }
 302
 303 /* llmodule -> string */
 304 CAMLprim value llvm_string_of_llmodule(LLVMModuleRef M) {
 305   CAMLparam0();
 306   CAMLlocal1(ModuleStr);
 307   char* ModuleCStr;
 308
 309   ModuleCStr = LLVMPrintModuleToString(M);
 310   ModuleStr = caml_copy_string(ModuleCStr);
 311   LLVMDisposeMessage(ModuleCStr);
 312
 313   CAMLreturn(ModuleStr);
 314 }
 315
 316 /* llmodule -> string -> unit */
 317 CAMLprim value llvm_set_module_inline_asm(LLVMModuleRef M, value Asm) {
 318   LLVMSetModuleInlineAsm(M, String_val(Asm));
 319   return Val_unit;
 320 }
 321
 322 /*===-- Types -------------------------------------------------------------===*/
 323
 324 /* lltype -> TypeKind.t */
 325 CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
 326   return Val_int(LLVMGetTypeKind(Ty));
 327 }
 328
 329 CAMLprim value llvm_type_is_sized(LLVMTypeRef Ty) {
 330     return Val_bool(LLVMTypeIsSized(Ty));
 331 }
 332
 333 /* lltype -> llcontext */
 334 CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) {
 335   return LLVMGetTypeContext(Ty);
 336 }
 337
 338 /* lltype -> unit */
 339 CAMLprim value llvm_dump_type(LLVMTypeRef Val) {
 340 #if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
 341   LLVMDumpType(Val);
 342 #else
 343   caml_raise_with_arg(*caml_named_value("Llvm.FeatureDisabled"),
 344       caml_copy_string("dump"));
 345 #endif
 346   return Val_unit;
 347 }
 348
 349 /* lltype -> string */
 350 CAMLprim value llvm_string_of_lltype(LLVMTypeRef M) {
 351   CAMLparam0();
 352   CAMLlocal1(TypeStr);
 353   char* TypeCStr;
 354
 355   TypeCStr = LLVMPrintTypeToString(M);
 356   TypeStr = caml_copy_string(TypeCStr);
 357   LLVMDisposeMessage(TypeCStr);
 358
 359   CAMLreturn(TypeStr);
 360 }
 361
 362 /*--... Operations on integer types ........................................--*/
 363
 364 /* llcontext -> lltype */
 365 CAMLprim LLVMTypeRef llvm_i1_type (LLVMContextRef Context) {
 366   return LLVMInt1TypeInContext(Context);
 367 }
 368
 369 /* llcontext -> lltype */
 370 CAMLprim LLVMTypeRef llvm_i8_type (LLVMContextRef Context) {
 371   return LLVMInt8TypeInContext(Context);
 372 }
 373
 374 /* llcontext -> lltype */
 375 CAMLprim LLVMTypeRef llvm_i16_type (LLVMContextRef Context) {
 376   return LLVMInt16TypeInContext(Context);
 377 }
 378
 379 /* llcontext -> lltype */
 380 CAMLprim LLVMTypeRef llvm_i32_type (LLVMContextRef Context) {
 381   return LLVMInt32TypeInContext(Context);
 382 }
 383
 384 /* llcontext -> lltype */
 385 CAMLprim LLVMTypeRef llvm_i64_type (LLVMContextRef Context) {
 386   return LLVMInt64TypeInContext(Context);
 387 }
 388
 389 /* llcontext -> int -> lltype */
 390 CAMLprim LLVMTypeRef llvm_integer_type(LLVMContextRef Context, value Width) {
 391   return LLVMIntTypeInContext(Context, Int_val(Width));
 392 }
 393
 394 /* lltype -> int */
 395 CAMLprim value llvm_integer_bitwidth(LLVMTypeRef IntegerTy) {
 396   return Val_int(LLVMGetIntTypeWidth(IntegerTy));
 397 }
 398
 399 /*--... Operations on real types ...........................................--*/
 400
 401 /* llcontext -> lltype */
 402 CAMLprim LLVMTypeRef llvm_float_type(LLVMContextRef Context) {
 403   return LLVMFloatTypeInContext(Context);
 404 }
 405
 406 /* llcontext -> lltype */
 407 CAMLprim LLVMTypeRef llvm_double_type(LLVMContextRef Context) {
 408   return LLVMDoubleTypeInContext(Context);
 409 }
 410
 411 /* llcontext -> lltype */
 412 CAMLprim LLVMTypeRef llvm_x86fp80_type(LLVMContextRef Context) {
 413   return LLVMX86FP80TypeInContext(Context);
 414 }
 415
 416 /* llcontext -> lltype */
 417 CAMLprim LLVMTypeRef llvm_fp128_type(LLVMContextRef Context) {
 418   return LLVMFP128TypeInContext(Context);
 419 }
 420
 421 /* llcontext -> lltype */
 422 CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) {
 423   return LLVMPPCFP128TypeInContext(Context);
 424 }
 425
 426 /*--... Operations on function types .......................................--*/
 427
 428 /* lltype -> lltype array -> lltype */
 429 CAMLprim LLVMTypeRef llvm_function_type(LLVMTypeRef RetTy, value ParamTys) {
 430   return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
 431                           Wosize_val(ParamTys), 0);
 432 }
 433
 434 /* lltype -> lltype array -> lltype */
 435 CAMLprim LLVMTypeRef llvm_var_arg_function_type(LLVMTypeRef RetTy,
 436                                                 value ParamTys) {
 437   return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
 438                           Wosize_val(ParamTys), 1);
 439 }
 440
 441 /* lltype -> bool */
 442 CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) {
 443   return Val_bool(LLVMIsFunctionVarArg(FunTy));
 444 }
 445
 446 /* lltype -> lltype array */
 447 CAMLprim value llvm_param_types(LLVMTypeRef FunTy) {
 448   value Tys = alloc(LLVMCountParamTypes(FunTy), 0);
 449   LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys);
 450   return Tys;
 451 }
 452
 453 /*--... Operations on struct types .........................................--*/
 454
 455 /* llcontext -> lltype array -> lltype */
 456 CAMLprim LLVMTypeRef llvm_struct_type(LLVMContextRef C, value ElementTypes) {
 457   return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
 458                                  Wosize_val(ElementTypes), 0);
 459 }
 460
 461 /* llcontext -> lltype array -> lltype */
 462 CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C,
 463                                              value ElementTypes) {
 464   return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
 465                                  Wosize_val(ElementTypes), 1);
 466 }
 467
 468 /* llcontext -> string -> lltype */
 469 CAMLprim LLVMTypeRef llvm_named_struct_type(LLVMContextRef C,
 470                                             value Name) {
 471   return LLVMStructCreateNamed(C, String_val(Name));
 472 }
 473
 474 CAMLprim value llvm_struct_set_body(LLVMTypeRef Ty,
 475                                     value ElementTypes,
 476                                     value Packed) {
 477   LLVMStructSetBody(Ty, (LLVMTypeRef *) ElementTypes,
 478                     Wosize_val(ElementTypes), Bool_val(Packed));
 479   return Val_unit;
 480 }
 481
 482 /* lltype -> string option */
 483 CAMLprim value llvm_struct_name(LLVMTypeRef Ty)
 484 {
 485   CAMLparam0();
 486   CAMLlocal1(result);
 487   const char *C = LLVMGetStructName(Ty);
 488   if (C) {
 489     result = caml_alloc_small(1, 0);
 490     Store_field(result, 0, caml_copy_string(C));
 491     CAMLreturn(result);
 492   }
 493   CAMLreturn(Val_int(0));
 494 }
 495
 496 /* lltype -> lltype array */
 497 CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) {
 498   value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
 499   LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys);
 500   return Tys;
 501 }
 502
 503 /* lltype -> bool */
 504 CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) {
 505   return Val_bool(LLVMIsPackedStruct(StructTy));
 506 }
 507
 508 /* lltype -> bool */
 509 CAMLprim value llvm_is_opaque(LLVMTypeRef StructTy) {
 510   return Val_bool(LLVMIsOpaqueStruct(StructTy));
 511 }
 512
 513 /* lltype -> bool */
 514 CAMLprim value llvm_is_literal(LLVMTypeRef StructTy) {
 515   return Val_bool(LLVMIsLiteralStruct(StructTy));
 516 }
 517
 518 /*--... Operations on array, pointer, and vector types .....................--*/
 519
 520 /* lltype -> lltype array */
 521 CAMLprim value llvm_subtypes(LLVMTypeRef Ty) {
 522     CAMLparam0();
 523     CAMLlocal1(Arr);
 524
 525     unsigned Size = LLVMGetNumContainedTypes(Ty);
 526
 527     Arr = caml_alloc(Size, 0);
 528
 529     LLVMGetSubtypes(Ty, (LLVMTypeRef *) Arr);
 530
 531     CAMLreturn(Arr);
 532 }
 533
 534 /* lltype -> int -> lltype */
 535 CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) {
 536   return LLVMArrayType(ElementTy, Int_val(Count));
 537 }
 538
 539 /* lltype -> lltype */
 540 CAMLprim LLVMTypeRef llvm_pointer_type(LLVMTypeRef ElementTy) {
 541   return LLVMPointerType(ElementTy, 0);
 542 }
 543
 544 /* lltype -> int -> lltype */
 545 CAMLprim LLVMTypeRef llvm_qualified_pointer_type(LLVMTypeRef ElementTy,
 546                                                  value AddressSpace) {
 547   return LLVMPointerType(ElementTy, Int_val(AddressSpace));
 548 }
 549
 550 /* lltype -> int -> lltype */
 551 CAMLprim LLVMTypeRef llvm_vector_type(LLVMTypeRef ElementTy, value Count) {
 552   return LLVMVectorType(ElementTy, Int_val(Count));
 553 }
 554
 555 /* lltype -> int */
 556 CAMLprim value llvm_array_length(LLVMTypeRef ArrayTy) {
 557   return Val_int(LLVMGetArrayLength(ArrayTy));
 558 }
 559
 560 /* lltype -> int */
 561 CAMLprim value llvm_address_space(LLVMTypeRef PtrTy) {
 562   return Val_int(LLVMGetPointerAddressSpace(PtrTy));
 563 }
 564
 565 /* lltype -> int */
 566 CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) {
 567   return Val_int(LLVMGetVectorSize(VectorTy));
 568 }
 569
 570 /*--... Operations on other types ..........................................--*/
 571
 572 /* llcontext -> lltype */
 573 CAMLprim LLVMTypeRef llvm_void_type (LLVMContextRef Context) {
 574   return LLVMVoidTypeInContext(Context);
 575 }
 576
 577 /* llcontext -> lltype */
 578 CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
 579   return LLVMLabelTypeInContext(Context);
 580 }
 581
 582 /* llcontext -> lltype */
 583 CAMLprim LLVMTypeRef llvm_x86_mmx_type(LLVMContextRef Context) {
 584   return LLVMX86MMXTypeInContext(Context);
 585 }
 586
 587 CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
 588 {
 589   CAMLparam1(Name);
 590   LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
 591   if (Ty) {
 592     value Option = alloc(1, 0);
 593     Field(Option, 0) = (value) Ty;
 594     CAMLreturn(Option);
 595   }
 596   CAMLreturn(Val_int(0));
 597 }
 598
 599 /*===-- VALUES ------------------------------------------------------------===*/
 600
 601 /* llvalue -> lltype */
 602 CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) {
 603   return LLVMTypeOf(Val);
 604 }
 605
 606 /* keep in sync with ValueKind.t */
 607 enum ValueKind {
 608   NullValue=0,
 609   Argument,
 610   BasicBlock,
 611   InlineAsm,
 612   MDNode,
 613   MDString,
 614   BlockAddress,
 615   ConstantAggregateZero,
 616   ConstantArray,
 617   ConstantDataArray,
 618   ConstantDataVector,
 619   ConstantExpr,
 620   ConstantFP,
 621   ConstantInt,
 622   ConstantPointerNull,
 623   ConstantStruct,
 624   ConstantVector,
 625   Function,
 626   GlobalAlias,
 627   GlobalIFunc,
 628   GlobalVariable,
 629   UndefValue,
 630   Instruction
 631 };
 632
 633 /* llvalue -> ValueKind.t */
 634 #define DEFINE_CASE(Val, Kind) \
 635     do {if (LLVMIsA##Kind(Val)) CAMLreturn(Val_int(Kind));} while(0)
 636
 637 CAMLprim value llvm_classify_value(LLVMValueRef Val) {
 638   CAMLparam0();
 639   CAMLlocal1(result);
 640   if (!Val)
 641     CAMLreturn(Val_int(NullValue));
 642   if (LLVMIsAConstant(Val)) {
 643     DEFINE_CASE(Val, BlockAddress);
 644     DEFINE_CASE(Val, ConstantAggregateZero);
 645     DEFINE_CASE(Val, ConstantArray);
 646     DEFINE_CASE(Val, ConstantDataArray);
 647     DEFINE_CASE(Val, ConstantDataVector);
 648     DEFINE_CASE(Val, ConstantExpr);
 649     DEFINE_CASE(Val, ConstantFP);
 650     DEFINE_CASE(Val, ConstantInt);
 651     DEFINE_CASE(Val, ConstantPointerNull);
 652     DEFINE_CASE(Val, ConstantStruct);
 653     DEFINE_CASE(Val, ConstantVector);
 654   }
 655   if (LLVMIsAInstruction(Val)) {
 656     result = caml_alloc_small(1, 0);
 657     Store_field(result, 0, Val_int(LLVMGetInstructionOpcode(Val)));
 658     CAMLreturn(result);
 659   }
 660   if (LLVMIsAGlobalValue(Val)) {
 661     DEFINE_CASE(Val, Function);
 662     DEFINE_CASE(Val, GlobalAlias);
 663     DEFINE_CASE(Val, GlobalIFunc);
 664     DEFINE_CASE(Val, GlobalVariable);
 665   }
 666   DEFINE_CASE(Val, Argument);
 667   DEFINE_CASE(Val, BasicBlock);
 668   DEFINE_CASE(Val, InlineAsm);
 669   DEFINE_CASE(Val, MDNode);
 670   DEFINE_CASE(Val, MDString);
 671   DEFINE_CASE(Val, UndefValue);
 672   failwith("Unknown Value class");
 673 }
 674
 675 /* llvalue -> string */
 676 CAMLprim value llvm_value_name(LLVMValueRef Val) {
 677   return caml_copy_string(LLVMGetValueName(Val));
 678 }
 679
 680 /* string -> llvalue -> unit */
 681 CAMLprim value llvm_set_value_name(value Name, LLVMValueRef Val) {
 682   LLVMSetValueName(Val, String_val(Name));
 683   return Val_unit;
 684 }
 685
 686 /* llvalue -> unit */
 687 CAMLprim value llvm_dump_value(LLVMValueRef Val) {
 688   LLVMDumpValue(Val);
 689   return Val_unit;
 690 }
 691
 692 /* llvalue -> string */
 693 CAMLprim value llvm_string_of_llvalue(LLVMValueRef M) {
 694   CAMLparam0();
 695   CAMLlocal1(ValueStr);
 696   char* ValueCStr;
 697
 698   ValueCStr = LLVMPrintValueToString(M);
 699   ValueStr = caml_copy_string(ValueCStr);
 700   LLVMDisposeMessage(ValueCStr);
 701
 702   CAMLreturn(ValueStr);
 703 }
 704
 705 /* llvalue -> llvalue -> unit */
 706 CAMLprim value llvm_replace_all_uses_with(LLVMValueRef OldVal,
 707                                           LLVMValueRef NewVal) {
 708   LLVMReplaceAllUsesWith(OldVal, NewVal);
 709   return Val_unit;
 710 }
 711
 712 /*--... Operations on users ................................................--*/
 713
 714 /* llvalue -> int -> llvalue */
 715 CAMLprim LLVMValueRef llvm_operand(LLVMValueRef V, value I) {
 716   return LLVMGetOperand(V, Int_val(I));
 717 }
 718
 719 /* llvalue -> int -> lluse */
 720 CAMLprim LLVMUseRef llvm_operand_use(LLVMValueRef V, value I) {
 721   return LLVMGetOperandUse(V, Int_val(I));
 722 }
 723
 724 /* llvalue -> int -> llvalue -> unit */
 725 CAMLprim value llvm_set_operand(LLVMValueRef U, value I, LLVMValueRef V) {
 726   LLVMSetOperand(U, Int_val(I), V);
 727   return Val_unit;
 728 }
 729
 730 /* llvalue -> int */
 731 CAMLprim value llvm_num_operands(LLVMValueRef V) {
 732   return Val_int(LLVMGetNumOperands(V));
 733 }
 734
 735 /* llvalue -> int array */
 736 CAMLprim value llvm_indices(LLVMValueRef Instr) {
 737   CAMLparam0();
 738   CAMLlocal1(indices);
 739   unsigned n = LLVMGetNumIndices(Instr);
 740   const unsigned *Indices = LLVMGetIndices(Instr);
 741   indices = caml_alloc(n, 0);
 742   for (unsigned i = 0; i < n; i++) {
 743     Op_val(indices)[i] = Val_int(Indices[i]);
 744   }
 745   CAMLreturn(indices);
 746 }
 747
 748 /*--... Operations on constants of (mostly) any type .......................--*/
 749
 750 /* llvalue -> bool */
 751 CAMLprim value llvm_is_constant(LLVMValueRef Val) {
 752   return Val_bool(LLVMIsConstant(Val));
 753 }
 754
 755 /* llvalue -> bool */
 756 CAMLprim value llvm_is_null(LLVMValueRef Val) {
 757   return Val_bool(LLVMIsNull(Val));
 758 }
 759
 760 /* llvalue -> bool */
 761 CAMLprim value llvm_is_undef(LLVMValueRef Val) {
 762   return Val_bool(LLVMIsUndef(Val));
 763 }
 764
 765 /* llvalue -> Opcode.t */
 766 CAMLprim value llvm_constexpr_get_opcode(LLVMValueRef Val) {
 767   return LLVMIsAConstantExpr(Val) ?
 768       Val_int(LLVMGetConstOpcode(Val)) : Val_int(0);
 769 }
 770
 771 /*--... Operations on instructions .........................................--*/
 772
 773 /* llvalue -> bool */
 774 CAMLprim value llvm_has_metadata(LLVMValueRef Val) {
 775   return Val_bool(LLVMHasMetadata(Val));
 776 }
 777
 778 /* llvalue -> int -> llvalue option */
 779 CAMLprim value llvm_metadata(LLVMValueRef Val, value MDKindID) {
 780   CAMLparam1(MDKindID);
 781   LLVMValueRef MD;
 782   if ((MD = LLVMGetMetadata(Val, Int_val(MDKindID)))) {
 783     value Option = alloc(1, 0);
 784     Field(Option, 0) = (value) MD;
 785     CAMLreturn(Option);
 786   }
 787   CAMLreturn(Val_int(0));
 788 }
 789
 790 /* llvalue -> int -> llvalue -> unit */
 791 CAMLprim value llvm_set_metadata(LLVMValueRef Val, value MDKindID,
 792                                  LLVMValueRef MD) {
 793   LLVMSetMetadata(Val, Int_val(MDKindID), MD);
 794   return Val_unit;
 795 }
 796
 797 /* llvalue -> int -> unit */
 798 CAMLprim value llvm_clear_metadata(LLVMValueRef Val, value MDKindID) {
 799   LLVMSetMetadata(Val, Int_val(MDKindID), NULL);
 800   return Val_unit;
 801 }
 802
 803
 804 /*--... Operations on metadata .............................................--*/
 805
 806 /* llcontext -> string -> llvalue */
 807 CAMLprim LLVMValueRef llvm_mdstring(LLVMContextRef C, value S) {
 808   return LLVMMDStringInContext(C, String_val(S), caml_string_length(S));
 809 }
 810
 811 /* llcontext -> llvalue array -> llvalue */
 812 CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) {
 813   return LLVMMDNodeInContext(C, (LLVMValueRef*) Op_val(ElementVals),
 814                              Wosize_val(ElementVals));
 815 }
 816
 817 /* llcontext -> llvalue */
 818 CAMLprim LLVMValueRef llvm_mdnull(LLVMContextRef C) {
 819   return NULL;
 820 }
 821
 822 /* llvalue -> string option */
 823 CAMLprim value llvm_get_mdstring(LLVMValueRef V) {
 824   CAMLparam0();
 825   CAMLlocal2(Option, Str);
 826   const char *S;
 827   unsigned Len;
 828
 829   if ((S = LLVMGetMDString(V, &Len))) {
 830     Str = caml_alloc_string(Len);
 831     memcpy(String_val(Str), S, Len);
 832     Option = alloc(1,0);
 833     Store_field(Option, 0, Str);
 834     CAMLreturn(Option);
 835   }
 836   CAMLreturn(Val_int(0));
 837 }
 838
 839 CAMLprim value llvm_get_mdnode_operands(LLVMValueRef V) {
 840   CAMLparam0();
 841   CAMLlocal1(Operands);
 842   unsigned int n;
 843
 844   n = LLVMGetMDNodeNumOperands(V);
 845   Operands = alloc(n, 0);
 846   LLVMGetMDNodeOperands(V, (LLVMValueRef *)  Operands);
 847   CAMLreturn(Operands);
 848 }
 849
 850 /* llmodule -> string -> llvalue array */
 851 CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value Name)
 852 {
 853   CAMLparam1(Name);
 854   CAMLlocal1(Nodes);
 855   Nodes = alloc(LLVMGetNamedMetadataNumOperands(M, String_val(Name)), 0);
 856   LLVMGetNamedMetadataOperands(M, String_val(Name), (LLVMValueRef *) Nodes);
 857   CAMLreturn(Nodes);
 858 }
 859
 860 /* llmodule -> string -> llvalue -> unit */
 861 CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef Val) {
 862   LLVMAddNamedMetadataOperand(M, String_val(Name), Val);
 863   return Val_unit;
 864 }
 865
 866 /*--... Operations on scalar constants .....................................--*/
 867
 868 /* lltype -> int -> llvalue */
 869 CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) {
 870   return LLVMConstInt(IntTy, (long long) Long_val(N), 1);
 871 }
 872
 873 /* lltype -> Int64.t -> bool -> llvalue */
 874 CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
 875                                           value SExt) {
 876   return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
 877 }
 878
 879 /* llvalue -> Int64.t */
 880 CAMLprim value llvm_int64_of_const(LLVMValueRef Const)
 881 {
 882   CAMLparam0();
 883   if (LLVMIsAConstantInt(Const) &&
 884       LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64) {
 885     value Option = alloc(1, 0);
 886     Field(Option, 0) = caml_copy_int64(LLVMConstIntGetSExtValue(Const));
 887     CAMLreturn(Option);
 888   }
 889   CAMLreturn(Val_int(0));
 890 }
 891
 892 /* lltype -> string -> int -> llvalue */
 893 CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
 894                                                value Radix) {
 895   return LLVMConstIntOfStringAndSize(IntTy, String_val(S), caml_string_length(S),
 896                                      Int_val(Radix));
 897 }
 898
 899 /* lltype -> float -> llvalue */
 900 CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) {
 901   return LLVMConstReal(RealTy, Double_val(N));
 902 }
 903
 904
 905 /* llvalue -> float */
 906 CAMLprim value llvm_float_of_const(LLVMValueRef Const)
 907 {
 908   CAMLparam0();
 909   CAMLlocal1(Option);
 910   LLVMBool LosesInfo;
 911   double Result;
 912
 913   if (LLVMIsAConstantFP(Const)) {
 914     Result = LLVMConstRealGetDouble(Const, &LosesInfo);
 915     if (LosesInfo)
 916         CAMLreturn(Val_int(0));
 917
 918     Option = alloc(1, 0);
 919     Field(Option, 0) = caml_copy_double(Result);
 920     CAMLreturn(Option);
 921   }
 922
 923   CAMLreturn(Val_int(0));
 924 }
 925
 926 /* lltype -> string -> llvalue */
 927 CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) {
 928   return LLVMConstRealOfStringAndSize(RealTy, String_val(S),
 929                                       caml_string_length(S));
 930 }
 931
 932 /*--... Operations on composite constants ..................................--*/
 933
 934 /* llcontext -> string -> llvalue */
 935 CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str,
 936                                         value NullTerminate) {
 937   return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
 938                                   1);
 939 }
 940
 941 /* llcontext -> string -> llvalue */
 942 CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str,
 943                                          value NullTerminate) {
 944   return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
 945                                   0);
 946 }
 947
 948 /* lltype -> llvalue array -> llvalue */
 949 CAMLprim LLVMValueRef llvm_const_array(LLVMTypeRef ElementTy,
 950                                                value ElementVals) {
 951   return LLVMConstArray(ElementTy, (LLVMValueRef*) Op_val(ElementVals),
 952                         Wosize_val(ElementVals));
 953 }
 954
 955 /* llcontext -> llvalue array -> llvalue */
 956 CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) {
 957   return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
 958                                   Wosize_val(ElementVals), 0);
 959 }
 960
 961 /* lltype -> llvalue array -> llvalue */
 962 CAMLprim LLVMValueRef llvm_const_named_struct(LLVMTypeRef Ty, value ElementVals) {
 963     return LLVMConstNamedStruct(Ty, (LLVMValueRef *) Op_val(ElementVals),  Wosize_val(ElementVals));
 964 }
 965
 966 /* llcontext -> llvalue array -> llvalue */
 967 CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C,
 968                                                value ElementVals) {
 969   return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
 970                                   Wosize_val(ElementVals), 1);
 971 }
 972
 973 /* llvalue array -> llvalue */
 974 CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
 975   return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals),
 976                          Wosize_val(ElementVals));
 977 }
 978
 979 /* llvalue -> string option */
 980 CAMLprim value llvm_string_of_const(LLVMValueRef Const) {
 981   const char *S;
 982   size_t Len;
 983   CAMLparam0();
 984   CAMLlocal2(Option, Str);
 985
 986   if(LLVMIsAConstantDataSequential(Const) && LLVMIsConstantString(Const)) {
 987     S = LLVMGetAsString(Const, &Len);
 988     Str = caml_alloc_string(Len);
 989     memcpy(String_val(Str), S, Len);
 990
 991     Option = alloc(1, 0);
 992     Field(Option, 0) = Str;
 993     CAMLreturn(Option);
 994   } else {
 995     CAMLreturn(Val_int(0));
 996   }
 997 }
 998
 999 /* llvalue -> int -> llvalue */
1000 CAMLprim LLVMValueRef llvm_const_element(LLVMValueRef Const, value N) {
1001   return LLVMGetElementAsConstant(Const, Int_val(N));
1002 }
1003
1004 /*--... Constant expressions ...............................................--*/
1005
1006 /* Icmp.t -> llvalue -> llvalue -> llvalue */
1007 CAMLprim LLVMValueRef llvm_const_icmp(value Pred,
1008                                       LLVMValueRef LHSConstant,
1009                                       LLVMValueRef RHSConstant) {
1010   return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant);
1011 }
1012
1013 /* Fcmp.t -> llvalue -> llvalue -> llvalue */
1014 CAMLprim LLVMValueRef llvm_const_fcmp(value Pred,
1015                                       LLVMValueRef LHSConstant,
1016                                       LLVMValueRef RHSConstant) {
1017   return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant);
1018 }
1019
1020 /* llvalue -> llvalue array -> llvalue */
1021 CAMLprim LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) {
1022   return LLVMConstGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
1023                       Wosize_val(Indices));
1024 }
1025
1026 /* llvalue -> llvalue array -> llvalue */
1027 CAMLprim LLVMValueRef llvm_const_in_bounds_gep(LLVMValueRef ConstantVal,
1028                                                value Indices) {
1029   return LLVMConstInBoundsGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
1030                               Wosize_val(Indices));
1031 }
1032
1033 /* llvalue -> lltype -> is_signed:bool -> llvalue */
1034 CAMLprim LLVMValueRef llvm_const_intcast(LLVMValueRef CV, LLVMTypeRef T,
1035                                          value IsSigned) {
1036   return LLVMConstIntCast(CV, T, Bool_val(IsSigned));
1037 }
1038
1039 /* llvalue -> int array -> llvalue */
1040 CAMLprim LLVMValueRef llvm_const_extractvalue(LLVMValueRef Aggregate,
1041                                               value Indices) {
1042   CAMLparam1(Indices);
1043   int size = Wosize_val(Indices);
1044   int i;
1045   LLVMValueRef result;
1046
1047   unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
1048   for (i = 0; i < size; i++) {
1049     idxs[i] = Int_val(Field(Indices, i));
1050   }
1051
1052   result = LLVMConstExtractValue(Aggregate, idxs, size);
1053   free(idxs);
1054   CAMLreturnT(LLVMValueRef, result);
1055 }
1056
1057 /* llvalue -> llvalue -> int array -> llvalue */
1058 CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate,
1059                                              LLVMValueRef Val, value Indices) {
1060   CAMLparam1(Indices);
1061   int size = Wosize_val(Indices);
1062   int i;
1063   LLVMValueRef result;
1064
1065   unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
1066   for (i = 0; i < size; i++) {
1067     idxs[i] = Int_val(Field(Indices, i));
1068   }
1069
1070   result = LLVMConstInsertValue(Aggregate, Val, idxs, size);
1071   free(idxs);
1072   CAMLreturnT(LLVMValueRef, result);
1073 }
1074
1075 /* lltype -> string -> string -> bool -> bool -> llvalue */
1076 CAMLprim LLVMValueRef llvm_const_inline_asm(LLVMTypeRef Ty, value Asm,
1077                                      value Constraints, value HasSideEffects,
1078                                      value IsAlignStack) {
1079   return LLVMConstInlineAsm(Ty, String_val(Asm), String_val(Constraints),
1080                             Bool_val(HasSideEffects), Bool_val(IsAlignStack));
1081 }
1082
1083 /*--... Operations on global variables, functions, and aliases (globals) ...--*/
1084
1085 /* llvalue -> bool */
1086 CAMLprim value llvm_is_declaration(LLVMValueRef Global) {
1087   return Val_bool(LLVMIsDeclaration(Global));
1088 }
1089
1090 /* llvalue -> Linkage.t */
1091 CAMLprim value llvm_linkage(LLVMValueRef Global) {
1092   return Val_int(LLVMGetLinkage(Global));
1093 }
1094
1095 /* Linkage.t -> llvalue -> unit */
1096 CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) {
1097   LLVMSetLinkage(Global, Int_val(Linkage));
1098   return Val_unit;
1099 }
1100
1101 /* llvalue -> bool */
1102 CAMLprim value llvm_unnamed_addr(LLVMValueRef Global) {
1103   return Val_bool(LLVMHasUnnamedAddr(Global));
1104 }
1105
1106 /* bool -> llvalue -> unit */
1107 CAMLprim value llvm_set_unnamed_addr(value UseUnnamedAddr, LLVMValueRef Global) {
1108   LLVMSetUnnamedAddr(Global, Bool_val(UseUnnamedAddr));
1109   return Val_unit;
1110 }
1111
1112 /* llvalue -> string */
1113 CAMLprim value llvm_section(LLVMValueRef Global) {
1114   return caml_copy_string(LLVMGetSection(Global));
1115 }
1116
1117 /* string -> llvalue -> unit */
1118 CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) {
1119   LLVMSetSection(Global, String_val(Section));
1120   return Val_unit;
1121 }
1122
1123 /* llvalue -> Visibility.t */
1124 CAMLprim value llvm_visibility(LLVMValueRef Global) {
1125   return Val_int(LLVMGetVisibility(Global));
1126 }
1127
1128 /* Visibility.t -> llvalue -> unit */
1129 CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) {
1130   LLVMSetVisibility(Global, Int_val(Viz));
1131   return Val_unit;
1132 }
1133
1134 /* llvalue -> DLLStorageClass.t */
1135 CAMLprim value llvm_dll_storage_class(LLVMValueRef Global) {
1136   return Val_int(LLVMGetDLLStorageClass(Global));
1137 }
1138
1139 /* DLLStorageClass.t -> llvalue -> unit */
1140 CAMLprim value llvm_set_dll_storage_class(value Viz, LLVMValueRef Global) {
1141   LLVMSetDLLStorageClass(Global, Int_val(Viz));
1142   return Val_unit;
1143 }
1144
1145 /* llvalue -> int */
1146 CAMLprim value llvm_alignment(LLVMValueRef Global) {
1147   return Val_int(LLVMGetAlignment(Global));
1148 }
1149
1150 /* int -> llvalue -> unit */
1151 CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
1152   LLVMSetAlignment(Global, Int_val(Bytes));
1153   return Val_unit;
1154 }
1155
1156 /*--... Operations on uses .................................................--*/
1157
1158 /* llvalue -> lluse option */
1159 CAMLprim value llvm_use_begin(LLVMValueRef Val) {
1160   CAMLparam0();
1161   LLVMUseRef First;
1162   if ((First = LLVMGetFirstUse(Val))) {
1163     value Option = alloc(1, 0);
1164     Field(Option, 0) = (value) First;
1165     CAMLreturn(Option);
1166   }
1167   CAMLreturn(Val_int(0));
1168 }
1169
1170 /* lluse -> lluse option */
1171 CAMLprim value llvm_use_succ(LLVMUseRef U) {
1172   CAMLparam0();
1173   LLVMUseRef Next;
1174   if ((Next = LLVMGetNextUse(U))) {
1175     value Option = alloc(1, 0);
1176     Field(Option, 0) = (value) Next;
1177     CAMLreturn(Option);
1178   }
1179   CAMLreturn(Val_int(0));
1180 }
1181
1182 /* lluse -> llvalue */
1183 CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) {
1184   return LLVMGetUser(UR);
1185 }
1186
1187 /* lluse -> llvalue */
1188 CAMLprim LLVMValueRef llvm_used_value(LLVMUseRef UR) {
1189   return LLVMGetUsedValue(UR);
1190 }
1191
1192 /*--... Operations on global variables .....................................--*/
1193
1194 DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef,
1195                  LLVMGetGlobalParent)
1196
1197 /* lltype -> string -> llmodule -> llvalue */
1198 CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
1199                                           LLVMModuleRef M) {
1200   LLVMValueRef GlobalVar;
1201   if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
1202     if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
1203       return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty, 0));
1204     return GlobalVar;
1205   }
1206   return LLVMAddGlobal(M, Ty, String_val(Name));
1207 }
1208
1209 /* lltype -> string -> int -> llmodule -> llvalue */
1210 CAMLprim LLVMValueRef llvm_declare_qualified_global(LLVMTypeRef Ty, value Name,
1211                                                     value AddressSpace,
1212                                                     LLVMModuleRef M) {
1213   LLVMValueRef GlobalVar;
1214   if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
1215     if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
1216       return LLVMConstBitCast(GlobalVar,
1217                               LLVMPointerType(Ty, Int_val(AddressSpace)));
1218     return GlobalVar;
1219   }
1220   return LLVMAddGlobalInAddressSpace(M, Ty, String_val(Name),
1221                                      Int_val(AddressSpace));
1222 }
1223
1224 /* string -> llmodule -> llvalue option */
1225 CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
1226   CAMLparam1(Name);
1227   LLVMValueRef GlobalVar;
1228   if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
1229     value Option = alloc(1, 0);
1230     Field(Option, 0) = (value) GlobalVar;
1231     CAMLreturn(Option);
1232   }
1233   CAMLreturn(Val_int(0));
1234 }
1235
1236 /* string -> llvalue -> llmodule -> llvalue */
1237 CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
1238                                          LLVMModuleRef M) {
1239   LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer),
1240                                          String_val(Name));
1241   LLVMSetInitializer(GlobalVar, Initializer);
1242   return GlobalVar;
1243 }
1244
1245 /* string -> llvalue -> int -> llmodule -> llvalue */
1246 CAMLprim LLVMValueRef llvm_define_qualified_global(value Name,
1247                                                    LLVMValueRef Initializer,
1248                                                    value AddressSpace,
1249                                                    LLVMModuleRef M) {
1250   LLVMValueRef GlobalVar = LLVMAddGlobalInAddressSpace(M,
1251                                                        LLVMTypeOf(Initializer),
1252                                                        String_val(Name),
1253                                                        Int_val(AddressSpace));
1254   LLVMSetInitializer(GlobalVar, Initializer);
1255   return GlobalVar;
1256 }
1257
1258 /* llvalue -> unit */
1259 CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) {
1260   LLVMDeleteGlobal(GlobalVar);
1261   return Val_unit;
1262 }
1263
1264 /* llvalue -> llvalue -> unit */
1265 CAMLprim value llvm_set_initializer(LLVMValueRef ConstantVal,
1266                                     LLVMValueRef GlobalVar) {
1267   LLVMSetInitializer(GlobalVar, ConstantVal);
1268   return Val_unit;
1269 }
1270
1271 /* llvalue -> unit */
1272 CAMLprim value llvm_remove_initializer(LLVMValueRef GlobalVar) {
1273   LLVMSetInitializer(GlobalVar, NULL);
1274   return Val_unit;
1275 }
1276
1277 /* llvalue -> bool */
1278 CAMLprim value llvm_is_thread_local(LLVMValueRef GlobalVar) {
1279   return Val_bool(LLVMIsThreadLocal(GlobalVar));
1280 }
1281
1282 /* bool -> llvalue -> unit */
1283 CAMLprim value llvm_set_thread_local(value IsThreadLocal,
1284                                      LLVMValueRef GlobalVar) {
1285   LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal));
1286   return Val_unit;
1287 }
1288
1289 /* llvalue -> ThreadLocalMode.t */
1290 CAMLprim value llvm_thread_local_mode(LLVMValueRef GlobalVar) {
1291   return Val_int(LLVMGetThreadLocalMode(GlobalVar));
1292 }
1293
1294 /* ThreadLocalMode.t -> llvalue -> unit */
1295 CAMLprim value llvm_set_thread_local_mode(value ThreadLocalMode,
1296                                           LLVMValueRef GlobalVar) {
1297   LLVMSetThreadLocalMode(GlobalVar, Int_val(ThreadLocalMode));
1298   return Val_unit;
1299 }
1300
1301 /* llvalue -> bool */
1302 CAMLprim value llvm_is_externally_initialized(LLVMValueRef GlobalVar) {
1303   return Val_bool(LLVMIsExternallyInitialized(GlobalVar));
1304 }
1305
1306 /* bool -> llvalue -> unit */
1307 CAMLprim value llvm_set_externally_initialized(value IsExternallyInitialized,
1308                                                LLVMValueRef GlobalVar) {
1309   LLVMSetExternallyInitialized(GlobalVar, Bool_val(IsExternallyInitialized));
1310   return Val_unit;
1311 }
1312
1313 /* llvalue -> bool */
1314 CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) {
1315   return Val_bool(LLVMIsGlobalConstant(GlobalVar));
1316 }
1317
1318 /* bool -> llvalue -> unit */
1319 CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
1320   LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag));
1321   return Val_unit;
1322 }
1323
1324 /*--... Operations on aliases ..............................................--*/
1325
1326 CAMLprim LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty,
1327                                      LLVMValueRef Aliasee, value Name) {
1328   return LLVMAddAlias(M, Ty, Aliasee, String_val(Name));
1329 }
1330
1331 /*--... Operations on functions ............................................--*/
1332
1333 DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef,
1334                  LLVMGetGlobalParent)
1335
1336 /* string -> lltype -> llmodule -> llvalue */
1337 CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
1338                                             LLVMModuleRef M) {
1339   LLVMValueRef Fn;
1340   if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
1341     if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
1342       return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0));
1343     return Fn;
1344   }
1345   return LLVMAddFunction(M, String_val(Name), Ty);
1346 }
1347
1348 /* string -> llmodule -> llvalue option */
1349 CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
1350   CAMLparam1(Name);
1351   LLVMValueRef Fn;
1352   if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
1353     value Option = alloc(1, 0);
1354     Field(Option, 0) = (value) Fn;
1355     CAMLreturn(Option);
1356   }
1357   CAMLreturn(Val_int(0));
1358 }
1359
1360 /* string -> lltype -> llmodule -> llvalue */
1361 CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
1362                                            LLVMModuleRef M) {
1363   LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
1364   LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry");
1365   return Fn;
1366 }
1367
1368 /* llvalue -> unit */
1369 CAMLprim value llvm_delete_function(LLVMValueRef Fn) {
1370   LLVMDeleteFunction(Fn);
1371   return Val_unit;
1372 }
1373
1374 /* llvalue -> bool */
1375 CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) {
1376   return Val_bool(LLVMGetIntrinsicID(Fn));
1377 }
1378
1379 /* llvalue -> int */
1380 CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) {
1381   return Val_int(LLVMGetFunctionCallConv(Fn));
1382 }
1383
1384 /* int -> llvalue -> unit */
1385 CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) {
1386   LLVMSetFunctionCallConv(Fn, Int_val(Id));
1387   return Val_unit;
1388 }
1389
1390 /* llvalue -> string option */
1391 CAMLprim value llvm_gc(LLVMValueRef Fn) {
1392   const char *GC;
1393   CAMLparam0();
1394   CAMLlocal2(Name, Option);
1395
1396   if ((GC = LLVMGetGC(Fn))) {
1397     Name = caml_copy_string(GC);
1398
1399     Option = alloc(1, 0);
1400     Field(Option, 0) = Name;
1401     CAMLreturn(Option);
1402   } else {
1403     CAMLreturn(Val_int(0));
1404   }
1405 }
1406
1407 /* string option -> llvalue -> unit */
1408 CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
1409   LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0)));
1410   return Val_unit;
1411 }
1412
1413 /* llvalue -> llattribute -> int -> unit */
1414 CAMLprim value llvm_add_function_attr(LLVMValueRef F, LLVMAttributeRef A,
1415                                       value Index) {
1416   LLVMAddAttributeAtIndex(F, Int_val(Index), A);
1417   return Val_unit;
1418 }
1419
1420 /* llvalue -> int -> llattribute array */
1421 CAMLprim value llvm_function_attrs(LLVMValueRef F, value Index) {
1422   unsigned Length = LLVMGetAttributeCountAtIndex(F, Int_val(Index));
1423   value Array = caml_alloc(Length, 0);
1424   LLVMGetAttributesAtIndex(F, Int_val(Index),
1425                            (LLVMAttributeRef *) Op_val(Array));
1426   return Array;
1427 }
1428
1429 /* llvalue -> llattrkind -> int -> unit */
1430 CAMLprim value llvm_remove_enum_function_attr(LLVMValueRef F, value Kind,
1431                                               value Index) {
1432   LLVMRemoveEnumAttributeAtIndex(F, Int_val(Index), Int_val(Kind));
1433   return Val_unit;
1434 }
1435
1436 /* llvalue -> string -> int -> unit */
1437 CAMLprim value llvm_remove_string_function_attr(LLVMValueRef F, value Kind,
1438                                                 value Index) {
1439   LLVMRemoveStringAttributeAtIndex(F, Int_val(Index), String_val(Kind),
1440                                    caml_string_length(Kind));
1441   return Val_unit;
1442 }
1443
1444 /*--... Operations on parameters ...........................................--*/
1445
1446 DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
1447
1448 /* llvalue -> int -> llvalue */
1449 CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
1450   return LLVMGetParam(Fn, Int_val(Index));
1451 }
1452
1453 /* llvalue -> llvalue */
1454 CAMLprim value llvm_params(LLVMValueRef Fn) {
1455   value Params = alloc(LLVMCountParams(Fn), 0);
1456   LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
1457   return Params;
1458 }
1459
1460 /*--... Operations on basic blocks .........................................--*/
1461
1462 DEFINE_ITERATORS(
1463   block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
1464
1465 /* llbasicblock -> llvalue option */
1466 CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
1467 {
1468   CAMLparam0();
1469   LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
1470   if (Term) {
1471     value Option = alloc(1, 0);
1472     Field(Option, 0) = (value) Term;
1473     CAMLreturn(Option);
1474   }
1475   CAMLreturn(Val_int(0));
1476 }
1477
1478 /* llvalue -> llbasicblock array */
1479 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
1480   value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
1481   LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
1482   return MLArray;
1483 }
1484
1485 /* llbasicblock -> unit */
1486 CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
1487   LLVMDeleteBasicBlock(BB);
1488   return Val_unit;
1489 }
1490
1491 /* llbasicblock -> unit */
1492 CAMLprim value llvm_remove_block(LLVMBasicBlockRef BB) {
1493   LLVMRemoveBasicBlockFromParent(BB);
1494   return Val_unit;
1495 }
1496
1497 /* llbasicblock -> llbasicblock -> unit */
1498 CAMLprim value llvm_move_block_before(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1499   LLVMMoveBasicBlockBefore(BB, Pos);
1500   return Val_unit;
1501 }
1502
1503 /* llbasicblock -> llbasicblock -> unit */
1504 CAMLprim value llvm_move_block_after(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1505   LLVMMoveBasicBlockAfter(BB, Pos);
1506   return Val_unit;
1507 }
1508
1509 /* string -> llvalue -> llbasicblock */
1510 CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
1511                                              LLVMValueRef Fn) {
1512   return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name));
1513 }
1514
1515 /* string -> llbasicblock -> llbasicblock */
1516 CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name,
1517                                              LLVMBasicBlockRef BB) {
1518   return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name));
1519 }
1520
1521 /* llvalue -> bool */
1522 CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
1523   return Val_bool(LLVMValueIsBasicBlock(Val));
1524 }
1525
1526 /*--... Operations on instructions .........................................--*/
1527
1528 DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
1529                  LLVMGetInstructionParent)
1530
1531 /* llvalue -> Opcode.t */
1532 CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
1533   LLVMOpcode o;
1534   if (!LLVMIsAInstruction(Inst))
1535       failwith("Not an instruction");
1536   o = LLVMGetInstructionOpcode(Inst);
1537   assert (o <= LLVMCallBr);
1538   return Val_int(o);
1539 }
1540
1541 /* llvalue -> ICmp.t option */
1542 CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
1543   CAMLparam0();
1544   int x = LLVMGetICmpPredicate(Val);
1545   if (x) {
1546     value Option = alloc(1, 0);
1547     Field(Option, 0) = Val_int(x - LLVMIntEQ);
1548     CAMLreturn(Option);
1549   }
1550   CAMLreturn(Val_int(0));
1551 }
1552
1553 /* llvalue -> FCmp.t option */
1554 CAMLprim value llvm_instr_fcmp_predicate(LLVMValueRef Val) {
1555   CAMLparam0();
1556   int x = LLVMGetFCmpPredicate(Val);
1557   if (x) {
1558     value Option = alloc(1, 0);
1559     Field(Option, 0) = Val_int(x - LLVMRealPredicateFalse);
1560     CAMLreturn(Option);
1561   }
1562   CAMLreturn(Val_int(0));
1563 }
1564
1565 /* llvalue -> llvalue */
1566 CAMLprim LLVMValueRef llvm_instr_clone(LLVMValueRef Inst) {
1567   if (!LLVMIsAInstruction(Inst))
1568       failwith("Not an instruction");
1569   return LLVMInstructionClone(Inst);
1570 }
1571
1572
1573 /*--... Operations on call sites ...........................................--*/
1574
1575 /* llvalue -> int */
1576 CAMLprim value llvm_instruction_call_conv(LLVMValueRef Inst) {
1577   return Val_int(LLVMGetInstructionCallConv(Inst));
1578 }
1579
1580 /* int -> llvalue -> unit */
1581 CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
1582   LLVMSetInstructionCallConv(Inst, Int_val(CC));
1583   return Val_unit;
1584 }
1585
1586 /* llvalue -> llattribute -> int -> unit */
1587 CAMLprim value llvm_add_call_site_attr(LLVMValueRef F, LLVMAttributeRef A,
1588                                        value Index) {
1589   LLVMAddCallSiteAttribute(F, Int_val(Index), A);
1590   return Val_unit;
1591 }
1592
1593 /* llvalue -> int -> llattribute array */
1594 CAMLprim value llvm_call_site_attrs(LLVMValueRef F, value Index) {
1595   unsigned Count = LLVMGetCallSiteAttributeCount(F, Int_val(Index));
1596   value Array = caml_alloc(Count, 0);
1597   LLVMGetCallSiteAttributes(F, Int_val(Index),
1598                             (LLVMAttributeRef *)Op_val(Array));
1599   return Array;
1600 }
1601
1602 /* llvalue -> llattrkind -> int -> unit */
1603 CAMLprim value llvm_remove_enum_call_site_attr(LLVMValueRef F, value Kind,
1604                                                value Index) {
1605   LLVMRemoveCallSiteEnumAttribute(F, Int_val(Index), Int_val(Kind));
1606   return Val_unit;
1607 }
1608
1609 /* llvalue -> string -> int -> unit */
1610 CAMLprim value llvm_remove_string_call_site_attr(LLVMValueRef F, value Kind,
1611                                                  value Index) {
1612   LLVMRemoveCallSiteStringAttribute(F, Int_val(Index), String_val(Kind),
1613                                     caml_string_length(Kind));
1614   return Val_unit;
1615 }
1616
1617 /*--... Operations on call instructions (only) .............................--*/
1618
1619 /* llvalue -> int */
1620 CAMLprim value llvm_num_arg_operands(LLVMValueRef V) {
1621   return Val_int(LLVMGetNumArgOperands(V));
1622 }
1623
1624 /* llvalue -> bool */
1625 CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) {
1626   return Val_bool(LLVMIsTailCall(CallInst));
1627 }
1628
1629 /* bool -> llvalue -> unit */
1630 CAMLprim value llvm_set_tail_call(value IsTailCall,
1631                                   LLVMValueRef CallInst) {
1632   LLVMSetTailCall(CallInst, Bool_val(IsTailCall));
1633   return Val_unit;
1634 }
1635
1636 /*--... Operations on load/store instructions (only)........................--*/
1637
1638 /* llvalue -> bool */
1639 CAMLprim value llvm_is_volatile(LLVMValueRef MemoryInst) {
1640   return Val_bool(LLVMGetVolatile(MemoryInst));
1641 }
1642
1643 /* bool -> llvalue -> unit */
1644 CAMLprim value llvm_set_volatile(value IsVolatile,
1645                                   LLVMValueRef MemoryInst) {
1646   LLVMSetVolatile(MemoryInst, Bool_val(IsVolatile));
1647   return Val_unit;
1648 }
1649
1650
1651 /*--.. Operations on terminators ...........................................--*/
1652
1653 /* llvalue -> int -> llbasicblock */
1654 CAMLprim LLVMBasicBlockRef llvm_successor(LLVMValueRef V, value I) {
1655   return LLVMGetSuccessor(V, Int_val(I));
1656 }
1657
1658 /* llvalue -> int -> llvalue -> unit */
1659 CAMLprim value llvm_set_successor(LLVMValueRef U, value I, LLVMBasicBlockRef B) {
1660   LLVMSetSuccessor(U, Int_val(I), B);
1661   return Val_unit;
1662 }
1663
1664 /* llvalue -> int */
1665 CAMLprim value llvm_num_successors(LLVMValueRef V) {
1666   return Val_int(LLVMGetNumSuccessors(V));
1667 }
1668
1669 /*--.. Operations on branch ................................................--*/
1670
1671 /* llvalue -> llvalue */
1672 CAMLprim LLVMValueRef llvm_condition(LLVMValueRef V) {
1673   return LLVMGetCondition(V);
1674 }
1675
1676 /* llvalue -> llvalue -> unit */
1677 CAMLprim value llvm_set_condition(LLVMValueRef B, LLVMValueRef C) {
1678   LLVMSetCondition(B, C);
1679   return Val_unit;
1680 }
1681
1682 /* llvalue -> bool */
1683 CAMLprim value llvm_is_conditional(LLVMValueRef V) {
1684   return Val_bool(LLVMIsConditional(V));
1685 }
1686
1687 /*--... Operations on phi nodes ............................................--*/
1688
1689 /* (llvalue * llbasicblock) -> llvalue -> unit */
1690 CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
1691   LLVMAddIncoming(PhiNode,
1692                   (LLVMValueRef*) &Field(Incoming, 0),
1693                   (LLVMBasicBlockRef*) &Field(Incoming, 1),
1694                   1);
1695   return Val_unit;
1696 }
1697
1698 /* llvalue -> (llvalue * llbasicblock) list */
1699 CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
1700   unsigned I;
1701   CAMLparam0();
1702   CAMLlocal3(Hd, Tl, Tmp);
1703
1704   /* Build a tuple list of them. */
1705   Tl = Val_int(0);
1706   for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
1707     Hd = alloc(2, 0);
1708     Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
1709     Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
1710
1711     Tmp = alloc(2, 0);
1712     Store_field(Tmp, 0, Hd);
1713     Store_field(Tmp, 1, Tl);
1714     Tl = Tmp;
1715   }
1716
1717   CAMLreturn(Tl);
1718 }
1719
1720 /* llvalue -> unit */
1721 CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
1722   LLVMInstructionEraseFromParent(Instruction);
1723   return Val_unit;
1724 }
1725
1726 /*===-- Instruction builders ----------------------------------------------===*/
1727
1728 #define Builder_val(v)  (*(LLVMBuilderRef *)(Data_custom_val(v)))
1729
1730 static void llvm_finalize_builder(value B) {
1731   LLVMDisposeBuilder(Builder_val(B));
1732 }
1733
1734 static struct custom_operations builder_ops = {
1735   (char *) "Llvm.llbuilder",
1736   llvm_finalize_builder,
1737   custom_compare_default,
1738   custom_hash_default,
1739   custom_serialize_default,
1740   custom_deserialize_default,
1741   custom_compare_ext_default
1742 };
1743
1744 static value alloc_builder(LLVMBuilderRef B) {
1745   value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
1746   Builder_val(V) = B;
1747   return V;
1748 }
1749
1750 /* llcontext -> llbuilder */
1751 CAMLprim value llvm_builder(LLVMContextRef C) {
1752   return alloc_builder(LLVMCreateBuilderInContext(C));
1753 }
1754
1755 /* (llbasicblock, llvalue) llpos -> llbuilder -> unit */
1756 CAMLprim value llvm_position_builder(value Pos, value B) {
1757   if (Tag_val(Pos) == 0) {
1758     LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0));
1759     LLVMPositionBuilderAtEnd(Builder_val(B), BB);
1760   } else {
1761     LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0));
1762     LLVMPositionBuilderBefore(Builder_val(B), I);
1763   }
1764   return Val_unit;
1765 }
1766
1767 /* llbuilder -> llbasicblock */
1768 CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) {
1769   LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
1770   if (!InsertBlock)
1771     caml_raise_not_found();
1772   return InsertBlock;
1773 }
1774
1775 /* llvalue -> string -> llbuilder -> unit */
1776 CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) {
1777   LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name));
1778   return Val_unit;
1779 }
1780
1781 /*--... Metadata ...........................................................--*/
1782
1783 /* llbuilder -> llvalue -> unit */
1784 CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) {
1785   LLVMSetCurrentDebugLocation(Builder_val(B), V);
1786   return Val_unit;
1787 }
1788
1789 /* llbuilder -> unit */
1790 CAMLprim value llvm_clear_current_debug_location(value B) {
1791   LLVMSetCurrentDebugLocation(Builder_val(B), NULL);
1792   return Val_unit;
1793 }
1794
1795 /* llbuilder -> llvalue option */
1796 CAMLprim value llvm_current_debug_location(value B) {
1797   CAMLparam0();
1798   LLVMValueRef L;
1799   if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) {
1800     value Option = alloc(1, 0);
1801     Field(Option, 0) = (value) L;
1802     CAMLreturn(Option);
1803   }
1804   CAMLreturn(Val_int(0));
1805 }
1806
1807 /* llbuilder -> llvalue -> unit */
1808 CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) {
1809   LLVMSetInstDebugLocation(Builder_val(B), V);
1810   return Val_unit;
1811 }
1812
1813
1814 /*--... Terminators ........................................................--*/
1815
1816 /* llbuilder -> llvalue */
1817 CAMLprim LLVMValueRef llvm_build_ret_void(value B) {
1818   return LLVMBuildRetVoid(Builder_val(B));
1819 }
1820
1821 /* llvalue -> llbuilder -> llvalue */
1822 CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) {
1823   return LLVMBuildRet(Builder_val(B), Val);
1824 }
1825
1826 /* llvalue array -> llbuilder -> llvalue */
1827 CAMLprim LLVMValueRef llvm_build_aggregate_ret(value RetVals, value B) {
1828   return LLVMBuildAggregateRet(Builder_val(B), (LLVMValueRef *) Op_val(RetVals),
1829                                Wosize_val(RetVals));
1830 }
1831
1832 /* llbasicblock -> llbuilder -> llvalue */
1833 CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) {
1834   return LLVMBuildBr(Builder_val(B), BB);
1835 }
1836
1837 /* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */
1838 CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If,
1839                                          LLVMBasicBlockRef Then,
1840                                          LLVMBasicBlockRef Else,
1841                                          value B) {
1842   return LLVMBuildCondBr(Builder_val(B), If, Then, Else);
1843 }
1844
1845 /* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */
1846 CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
1847                                         LLVMBasicBlockRef Else,
1848                                         value EstimatedCount,
1849                                         value B) {
1850   return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
1851 }
1852
1853 /* lltype -> string -> llbuilder -> llvalue */
1854 CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
1855                                         value B)
1856 {
1857   return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
1858 }
1859
1860 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
1861 CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
1862                                               LLVMValueRef Val,
1863                                               value Name, value B)
1864 {
1865   return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
1866 }
1867
1868 /* llvalue -> llbuilder -> llvalue */
1869 CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
1870 {
1871   return LLVMBuildFree(Builder_val(B), P);
1872 }
1873
1874 /* llvalue -> llvalue -> llbasicblock -> unit */
1875 CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
1876                              LLVMBasicBlockRef Dest) {
1877   LLVMAddCase(Switch, OnVal, Dest);
1878   return Val_unit;
1879 }
1880
1881 /* llvalue -> llbasicblock -> llbuilder -> llvalue */
1882 CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr,
1883                                              value EstimatedDests,
1884                                              value B) {
1885   return LLVMBuildIndirectBr(Builder_val(B), Addr, EstimatedDests);
1886 }
1887
1888 /* llvalue -> llvalue -> llbasicblock -> unit */
1889 CAMLprim value llvm_add_destination(LLVMValueRef IndirectBr,
1890                                     LLVMBasicBlockRef Dest) {
1891   LLVMAddDestination(IndirectBr, Dest);
1892   return Val_unit;
1893 }
1894
1895 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1896    llbuilder -> llvalue */
1897 CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
1898                                             LLVMBasicBlockRef Then,
1899                                             LLVMBasicBlockRef Catch,
1900                                             value Name, value B) {
1901   return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Args),
1902                          Wosize_val(Args), Then, Catch, String_val(Name));
1903 }
1904
1905 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1906    llbuilder -> llvalue */
1907 CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
1908   return llvm_build_invoke_nat((LLVMValueRef) Args[0], Args[1],
1909                                (LLVMBasicBlockRef) Args[2],
1910                                (LLVMBasicBlockRef) Args[3],
1911                                Args[4], Args[5]);
1912 }
1913
1914 /* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
1915 CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
1916                                             value NumClauses,  value Name,
1917                                             value B) {
1918     return LLVMBuildLandingPad(Builder_val(B), Ty, PersFn, Int_val(NumClauses),
1919                                String_val(Name));
1920 }
1921
1922 /* llvalue -> llvalue -> unit */
1923 CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
1924 {
1925     LLVMAddClause(LandingPadInst, ClauseVal);
1926     return Val_unit;
1927 }
1928
1929 /* llvalue -> bool */
1930 CAMLprim value llvm_is_cleanup(LLVMValueRef LandingPadInst)
1931 {
1932     return Val_bool(LLVMIsCleanup(LandingPadInst));
1933 }
1934
1935 /* llvalue -> bool -> unit */
1936 CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
1937 {
1938     LLVMSetCleanup(LandingPadInst, Bool_val(flag));
1939     return Val_unit;
1940 }
1941
1942 /* llvalue -> llbuilder -> llvalue */
1943 CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
1944 {
1945     return LLVMBuildResume(Builder_val(B), Exn);
1946 }
1947
1948 /* llbuilder -> llvalue */
1949 CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
1950   return LLVMBuildUnreachable(Builder_val(B));
1951 }
1952
1953 /*--... Arithmetic .........................................................--*/
1954
1955 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1956 CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS,
1957                                      value Name, value B) {
1958   return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name));
1959 }
1960
1961 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1962 CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1963                                          value Name, value B) {
1964   return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1965 }
1966
1967 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1968 CAMLprim LLVMValueRef llvm_build_nuw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1969                                          value Name, value B) {
1970   return LLVMBuildNUWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1971 }
1972
1973 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1974 CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS,
1975                                       value Name, value B) {
1976   return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name));
1977 }
1978
1979 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1980 CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1981                                      value Name, value B) {
1982   return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name));
1983 }
1984
1985 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1986 CAMLprim LLVMValueRef llvm_build_nsw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1987                                          value Name, value B) {
1988   return LLVMBuildNSWSub(Builder_val(B), LHS, RHS, String_val(Name));
1989 }
1990
1991 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1992 CAMLprim LLVMValueRef llvm_build_nuw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1993                                          value Name, value B) {
1994   return LLVMBuildNUWSub(Builder_val(B), LHS, RHS, String_val(Name));
1995 }
1996
1997 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1998 CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS,
1999                                       value Name, value B) {
2000   return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name));
2001 }
2002
2003 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2004 CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS,
2005                                      value Name, value B) {
2006   return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name));
2007 }
2008
2009 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2010 CAMLprim LLVMValueRef llvm_build_nsw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
2011                                          value Name, value B) {
2012   return LLVMBuildNSWMul(Builder_val(B), LHS, RHS, String_val(Name));
2013 }
2014
2015 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2016 CAMLprim LLVMValueRef llvm_build_nuw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
2017                                          value Name, value B) {
2018   return LLVMBuildNUWMul(Builder_val(B), LHS, RHS, String_val(Name));
2019 }
2020
2021 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2022 CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS,
2023                                       value Name, value B) {
2024   return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name));
2025 }
2026
2027 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2028 CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS,
2029                                       value Name, value B) {
2030   return LLVMBuildUDiv(Builder_val(B), LHS, RHS, String_val(Name));
2031 }
2032
2033 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2034 CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
2035                                       value Name, value B) {
2036   return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name));
2037 }
2038
2039 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2040 CAMLprim LLVMValueRef llvm_build_exact_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
2041                                             value Name, value B) {
2042   return LLVMBuildExactSDiv(Builder_val(B), LHS, RHS, String_val(Name));
2043 }
2044
2045 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2046 CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS,
2047                                       value Name, value B) {
2048   return LLVMBuildFDiv(Builder_val(B), LHS, RHS, String_val(Name));
2049 }
2050
2051 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2052 CAMLprim LLVMValueRef llvm_build_urem(LLVMValueRef LHS, LLVMValueRef RHS,
2053                                       value Name, value B) {
2054   return LLVMBuildURem(Builder_val(B), LHS, RHS, String_val(Name));
2055 }
2056
2057 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2058 CAMLprim LLVMValueRef llvm_build_srem(LLVMValueRef LHS, LLVMValueRef RHS,
2059                                       value Name, value B) {
2060   return LLVMBuildSRem(Builder_val(B), LHS, RHS, String_val(Name));
2061 }
2062
2063 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2064 CAMLprim LLVMValueRef llvm_build_frem(LLVMValueRef LHS, LLVMValueRef RHS,
2065                                       value Name, value B) {
2066   return LLVMBuildFRem(Builder_val(B), LHS, RHS, String_val(Name));
2067 }
2068
2069 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2070 CAMLprim LLVMValueRef llvm_build_shl(LLVMValueRef LHS, LLVMValueRef RHS,
2071                                      value Name, value B) {
2072   return LLVMBuildShl(Builder_val(B), LHS, RHS, String_val(Name));
2073 }
2074
2075 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2076 CAMLprim LLVMValueRef llvm_build_lshr(LLVMValueRef LHS, LLVMValueRef RHS,
2077                                       value Name, value B) {
2078   return LLVMBuildLShr(Builder_val(B), LHS, RHS, String_val(Name));
2079 }
2080
2081 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2082 CAMLprim LLVMValueRef llvm_build_ashr(LLVMValueRef LHS, LLVMValueRef RHS,
2083                                       value Name, value B) {
2084   return LLVMBuildAShr(Builder_val(B), LHS, RHS, String_val(Name));
2085 }
2086
2087 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2088 CAMLprim LLVMValueRef llvm_build_and(LLVMValueRef LHS, LLVMValueRef RHS,
2089                                      value Name, value B) {
2090   return LLVMBuildAnd(Builder_val(B), LHS, RHS, String_val(Name));
2091 }
2092
2093 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2094 CAMLprim LLVMValueRef llvm_build_or(LLVMValueRef LHS, LLVMValueRef RHS,
2095                                     value Name, value B) {
2096   return LLVMBuildOr(Builder_val(B), LHS, RHS, String_val(Name));
2097 }
2098
2099 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2100 CAMLprim LLVMValueRef llvm_build_xor(LLVMValueRef LHS, LLVMValueRef RHS,
2101                                      value Name, value B) {
2102   return LLVMBuildXor(Builder_val(B), LHS, RHS, String_val(Name));
2103 }
2104
2105 /* llvalue -> string -> llbuilder -> llvalue */
2106 CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X,
2107                                      value Name, value B) {
2108   return LLVMBuildNeg(Builder_val(B), X, String_val(Name));
2109 }
2110
2111 /* llvalue -> string -> llbuilder -> llvalue */
2112 CAMLprim LLVMValueRef llvm_build_nsw_neg(LLVMValueRef X,
2113                                          value Name, value B) {
2114   return LLVMBuildNSWNeg(Builder_val(B), X, String_val(Name));
2115 }
2116
2117 /* llvalue -> string -> llbuilder -> llvalue */
2118 CAMLprim LLVMValueRef llvm_build_nuw_neg(LLVMValueRef X,
2119                                          value Name, value B) {
2120   return LLVMBuildNUWNeg(Builder_val(B), X, String_val(Name));
2121 }
2122
2123 /* llvalue -> string -> llbuilder -> llvalue */
2124 CAMLprim LLVMValueRef llvm_build_fneg(LLVMValueRef X,
2125                                      value Name, value B) {
2126   return LLVMBuildFNeg(Builder_val(B), X, String_val(Name));
2127 }
2128
2129 /* llvalue -> string -> llbuilder -> llvalue */
2130 CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X,
2131                                      value Name, value B) {
2132   return LLVMBuildNot(Builder_val(B), X, String_val(Name));
2133 }
2134
2135 /*--... Memory .............................................................--*/
2136
2137 /* lltype -> string -> llbuilder -> llvalue */
2138 CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty,
2139                                         value Name, value B) {
2140   return LLVMBuildAlloca(Builder_val(B), Ty, String_val(Name));
2141 }
2142
2143 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
2144 CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size,
2145                                               value Name, value B) {
2146   return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name));
2147 }
2148
2149 /* llvalue -> string -> llbuilder -> llvalue */
2150 CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer,
2151                                       value Name, value B) {
2152   return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name));
2153 }
2154
2155 /* llvalue -> llvalue -> llbuilder -> llvalue */
2156 CAMLprim LLVMValueRef llvm_build_store(LLVMValueRef Value, LLVMValueRef Pointer,
2157                                        value B) {
2158   return LLVMBuildStore(Builder_val(B), Value, Pointer);
2159 }
2160
2161 /* AtomicRMWBinOp.t -> llvalue -> llvalue -> AtomicOrdering.t ->
2162    bool -> llbuilder -> llvalue */
2163 CAMLprim LLVMValueRef llvm_build_atomicrmw_native(value BinOp, LLVMValueRef Ptr,
2164                                                   LLVMValueRef Val, value Ord,
2165                                                   value ST, value Name, value B) {
2166   LLVMValueRef Instr;
2167   Instr = LLVMBuildAtomicRMW(Builder_val(B), Int_val(BinOp),
2168                              Ptr, Val, Int_val(Ord), Bool_val(ST));
2169   LLVMSetValueName(Instr, String_val(Name));
2170   return Instr;
2171 }
2172
2173 CAMLprim LLVMValueRef llvm_build_atomicrmw_bytecode(value *argv, int argn) {
2174   return llvm_build_atomicrmw_native(argv[0], (LLVMValueRef) argv[1],
2175                                      (LLVMValueRef) argv[2], argv[3],
2176                                      argv[4], argv[5], argv[6]);
2177 }
2178
2179 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
2180 CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices,
2181                                      value Name, value B) {
2182   return LLVMBuildGEP(Builder_val(B), Pointer,
2183                       (LLVMValueRef *) Op_val(Indices), Wosize_val(Indices),
2184                       String_val(Name));
2185 }
2186
2187 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
2188 CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer,
2189                                                value Indices, value Name,
2190                                                value B) {
2191   return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
2192                               (LLVMValueRef *) Op_val(Indices),
2193                               Wosize_val(Indices), String_val(Name));
2194 }
2195
2196 /* llvalue -> int -> string -> llbuilder -> llvalue */
2197 CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer,
2198                                                value Index, value Name,
2199                                                value B) {
2200   return LLVMBuildStructGEP(Builder_val(B), Pointer,
2201                               Int_val(Index), String_val(Name));
2202 }
2203
2204 /* string -> string -> llbuilder -> llvalue */
2205 CAMLprim LLVMValueRef llvm_build_global_string(value Str, value Name, value B) {
2206   return LLVMBuildGlobalString(Builder_val(B), String_val(Str),
2207                                String_val(Name));
2208 }
2209
2210 /* string -> string -> llbuilder -> llvalue */
2211 CAMLprim LLVMValueRef llvm_build_global_stringptr(value Str, value Name,
2212                                                   value B) {
2213   return LLVMBuildGlobalStringPtr(Builder_val(B), String_val(Str),
2214                                   String_val(Name));
2215 }
2216
2217 /*--... Casts ..............................................................--*/
2218
2219 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2220 CAMLprim LLVMValueRef llvm_build_trunc(LLVMValueRef X, LLVMTypeRef Ty,
2221                                        value Name, value B) {
2222   return LLVMBuildTrunc(Builder_val(B), X, Ty, String_val(Name));
2223 }
2224
2225 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2226 CAMLprim LLVMValueRef llvm_build_zext(LLVMValueRef X, LLVMTypeRef Ty,
2227                                       value Name, value B) {
2228   return LLVMBuildZExt(Builder_val(B), X, Ty, String_val(Name));
2229 }
2230
2231 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2232 CAMLprim LLVMValueRef llvm_build_sext(LLVMValueRef X, LLVMTypeRef Ty,
2233                                       value Name, value B) {
2234   return LLVMBuildSExt(Builder_val(B), X, Ty, String_val(Name));
2235 }
2236
2237 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2238 CAMLprim LLVMValueRef llvm_build_fptoui(LLVMValueRef X, LLVMTypeRef Ty,
2239                                         value Name, value B) {
2240   return LLVMBuildFPToUI(Builder_val(B), X, Ty, String_val(Name));
2241 }
2242
2243 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2244 CAMLprim LLVMValueRef llvm_build_fptosi(LLVMValueRef X, LLVMTypeRef Ty,
2245                                         value Name, value B) {
2246   return LLVMBuildFPToSI(Builder_val(B), X, Ty, String_val(Name));
2247 }
2248
2249 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2250 CAMLprim LLVMValueRef llvm_build_uitofp(LLVMValueRef X, LLVMTypeRef Ty,
2251                                         value Name, value B) {
2252   return LLVMBuildUIToFP(Builder_val(B), X, Ty, String_val(Name));
2253 }
2254
2255 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2256 CAMLprim LLVMValueRef llvm_build_sitofp(LLVMValueRef X, LLVMTypeRef Ty,
2257                                         value Name, value B) {
2258   return LLVMBuildSIToFP(Builder_val(B), X, Ty, String_val(Name));
2259 }
2260
2261 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2262 CAMLprim LLVMValueRef llvm_build_fptrunc(LLVMValueRef X, LLVMTypeRef Ty,
2263                                          value Name, value B) {
2264   return LLVMBuildFPTrunc(Builder_val(B), X, Ty, String_val(Name));
2265 }
2266
2267 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2268 CAMLprim LLVMValueRef llvm_build_fpext(LLVMValueRef X, LLVMTypeRef Ty,
2269                                        value Name, value B) {
2270   return LLVMBuildFPExt(Builder_val(B), X, Ty, String_val(Name));
2271 }
2272
2273 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2274 CAMLprim LLVMValueRef llvm_build_prttoint(LLVMValueRef X, LLVMTypeRef Ty,
2275                                           value Name, value B) {
2276   return LLVMBuildPtrToInt(Builder_val(B), X, Ty, String_val(Name));
2277 }
2278
2279 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2280 CAMLprim LLVMValueRef llvm_build_inttoptr(LLVMValueRef X, LLVMTypeRef Ty,
2281                                           value Name, value B) {
2282   return LLVMBuildIntToPtr(Builder_val(B), X, Ty, String_val(Name));
2283 }
2284
2285 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2286 CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
2287                                          value Name, value B) {
2288   return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name));
2289 }
2290
2291 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2292 CAMLprim LLVMValueRef llvm_build_zext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
2293                                                  value Name, value B) {
2294   return LLVMBuildZExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
2295 }
2296
2297 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2298 CAMLprim LLVMValueRef llvm_build_sext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
2299                                                  value Name, value B) {
2300   return LLVMBuildSExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
2301 }
2302
2303 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2304 CAMLprim LLVMValueRef llvm_build_trunc_or_bitcast(LLVMValueRef X,
2305                                                   LLVMTypeRef Ty, value Name,
2306                                                   value B) {
2307   return LLVMBuildTruncOrBitCast(Builder_val(B), X, Ty, String_val(Name));
2308 }
2309
2310 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2311 CAMLprim LLVMValueRef llvm_build_pointercast(LLVMValueRef X, LLVMTypeRef Ty,
2312                                              value Name, value B) {
2313   return LLVMBuildPointerCast(Builder_val(B), X, Ty, String_val(Name));
2314 }
2315
2316 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2317 CAMLprim LLVMValueRef llvm_build_intcast(LLVMValueRef X, LLVMTypeRef Ty,
2318                                          value Name, value B) {
2319   return LLVMBuildIntCast(Builder_val(B), X, Ty, String_val(Name));
2320 }
2321
2322 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2323 CAMLprim LLVMValueRef llvm_build_fpcast(LLVMValueRef X, LLVMTypeRef Ty,
2324                                         value Name, value B) {
2325   return LLVMBuildFPCast(Builder_val(B), X, Ty, String_val(Name));
2326 }
2327
2328 /*--... Comparisons ........................................................--*/
2329
2330 /* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2331 CAMLprim LLVMValueRef llvm_build_icmp(value Pred,
2332                                       LLVMValueRef LHS, LLVMValueRef RHS,
2333                                       value Name, value B) {
2334   return LLVMBuildICmp(Builder_val(B), Int_val(Pred) + LLVMIntEQ, LHS, RHS,
2335                        String_val(Name));
2336 }
2337
2338 /* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2339 CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
2340                                       LLVMValueRef LHS, LLVMValueRef RHS,
2341                                       value Name, value B) {
2342   return LLVMBuildFCmp(Builder_val(B), Int_val(Pred), LHS, RHS,
2343                        String_val(Name));
2344 }
2345
2346 /*--... Miscellaneous instructions .........................................--*/
2347
2348 /* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */
2349 CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
2350   value Hd, Tl;
2351   LLVMValueRef FirstValue, PhiNode;
2352
2353   assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
2354
2355   Hd = Field(Incoming, 0);
2356   FirstValue = (LLVMValueRef) Field(Hd, 0);
2357   PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
2358                          String_val(Name));
2359
2360   for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) {
2361     value Hd = Field(Tl, 0);
2362     LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
2363                     (LLVMBasicBlockRef*) &Field(Hd, 1), 1);
2364   }
2365
2366   return PhiNode;
2367 }
2368
2369 /* lltype -> string -> llbuilder -> value */
2370 CAMLprim LLVMValueRef llvm_build_empty_phi(LLVMTypeRef Type, value Name, value B) {
2371   LLVMValueRef PhiNode;
2372
2373   return LLVMBuildPhi(Builder_val(B), Type, String_val(Name));
2374
2375   return PhiNode;
2376 }
2377
2378 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
2379 CAMLprim LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params,
2380                                       value Name, value B) {
2381   return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Params),
2382                        Wosize_val(Params), String_val(Name));
2383 }
2384
2385 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2386 CAMLprim LLVMValueRef llvm_build_select(LLVMValueRef If,
2387                                         LLVMValueRef Then, LLVMValueRef Else,
2388                                         value Name, value B) {
2389   return LLVMBuildSelect(Builder_val(B), If, Then, Else, String_val(Name));
2390 }
2391
2392 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
2393 CAMLprim LLVMValueRef llvm_build_va_arg(LLVMValueRef List, LLVMTypeRef Ty,
2394                                         value Name, value B) {
2395   return LLVMBuildVAArg(Builder_val(B), List, Ty, String_val(Name));
2396 }
2397
2398 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2399 CAMLprim LLVMValueRef llvm_build_extractelement(LLVMValueRef Vec,
2400                                                 LLVMValueRef Idx,
2401                                                 value Name, value B) {
2402   return LLVMBuildExtractElement(Builder_val(B), Vec, Idx, String_val(Name));
2403 }
2404
2405 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2406 CAMLprim LLVMValueRef llvm_build_insertelement(LLVMValueRef Vec,
2407                                                LLVMValueRef Element,
2408                                                LLVMValueRef Idx,
2409                                                value Name, value B) {
2410   return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx,
2411                                 String_val(Name));
2412 }
2413
2414 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2415 CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2,
2416                                                LLVMValueRef Mask,
2417                                                value Name, value B) {
2418   return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name));
2419 }
2420
2421 /* llvalue -> int -> string -> llbuilder -> llvalue */
2422 CAMLprim LLVMValueRef llvm_build_extractvalue(LLVMValueRef Aggregate,
2423                                               value Idx, value Name, value B) {
2424   return LLVMBuildExtractValue(Builder_val(B), Aggregate, Int_val(Idx),
2425                                String_val(Name));
2426 }
2427
2428 /* llvalue -> llvalue -> int -> string -> llbuilder -> llvalue */
2429 CAMLprim LLVMValueRef llvm_build_insertvalue(LLVMValueRef Aggregate,
2430                                              LLVMValueRef Val, value Idx,
2431                                              value Name, value B) {
2432   return LLVMBuildInsertValue(Builder_val(B), Aggregate, Val, Int_val(Idx),
2433                               String_val(Name));
2434 }
2435
2436 /* llvalue -> string -> llbuilder -> llvalue */
2437 CAMLprim LLVMValueRef llvm_build_is_null(LLVMValueRef Val, value Name,
2438                                          value B) {
2439   return LLVMBuildIsNull(Builder_val(B), Val, String_val(Name));
2440 }
2441
2442 /* llvalue -> string -> llbuilder -> llvalue */
2443 CAMLprim LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name,
2444                                              value B) {
2445   return LLVMBuildIsNotNull(Builder_val(B), Val, String_val(Name));
2446 }
2447
2448 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2449 CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS,
2450                                          value Name, value B) {
2451   return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name));
2452 }
2453
2454 /*===-- Memory buffers ----------------------------------------------------===*/
2455
2456 /* string -> llmemorybuffer
2457    raises IoError msg on error */
2458 CAMLprim value llvm_memorybuffer_of_file(value Path) {
2459   CAMLparam1(Path);
2460   char *Message;
2461   LLVMMemoryBufferRef MemBuf;
2462
2463   if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path),
2464                                                &MemBuf, &Message))
2465     llvm_raise(*caml_named_value("Llvm.IoError"), Message);
2466
2467   CAMLreturn((value) MemBuf);
2468 }
2469
2470 /* unit -> llmemorybuffer
2471    raises IoError msg on error */
2472 CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
2473   char *Message;
2474   LLVMMemoryBufferRef MemBuf;
2475
2476   if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message))
2477     llvm_raise(*caml_named_value("Llvm.IoError"), Message);
2478
2479   return MemBuf;
2480 }
2481
2482 /* ?name:string -> string -> llmemorybuffer */
2483 CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_string(value Name, value String) {
2484   LLVMMemoryBufferRef MemBuf;
2485   const char *NameCStr;
2486
2487   if(Name == Val_int(0))
2488     NameCStr = "";
2489   else
2490     NameCStr = String_val(Field(Name, 0));
2491
2492   MemBuf = LLVMCreateMemoryBufferWithMemoryRangeCopy(
2493                 String_val(String), caml_string_length(String), NameCStr);
2494
2495   return MemBuf;
2496 }
2497
2498 /* llmemorybuffer -> string */
2499 CAMLprim value llvm_memorybuffer_as_string(LLVMMemoryBufferRef MemBuf) {
2500   value String = caml_alloc_string(LLVMGetBufferSize(MemBuf));
2501   memcpy(String_val(String), LLVMGetBufferStart(MemBuf),
2502          LLVMGetBufferSize(MemBuf));
2503
2504   return String;
2505 }
2506
2507 /* llmemorybuffer -> unit */
2508 CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) {
2509   LLVMDisposeMemoryBuffer(MemBuf);
2510   return Val_unit;
2511 }
2512
2513 /*===-- Pass Managers -----------------------------------------------------===*/
2514
2515 /* unit -> [ `Module ] PassManager.t */
2516 CAMLprim LLVMPassManagerRef llvm_passmanager_create(value Unit) {
2517   return LLVMCreatePassManager();
2518 }
2519
2520 /* llmodule -> [ `Function ] PassManager.t -> bool */
2521 CAMLprim value llvm_passmanager_run_module(LLVMModuleRef M,
2522                                            LLVMPassManagerRef PM) {
2523   return Val_bool(LLVMRunPassManager(PM, M));
2524 }
2525
2526 /* [ `Function ] PassManager.t -> bool */
2527 CAMLprim value llvm_passmanager_initialize(LLVMPassManagerRef FPM) {
2528   return Val_bool(LLVMInitializeFunctionPassManager(FPM));
2529 }
2530
2531 /* llvalue -> [ `Function ] PassManager.t -> bool */
2532 CAMLprim value llvm_passmanager_run_function(LLVMValueRef F,
2533                                              LLVMPassManagerRef FPM) {
2534   return Val_bool(LLVMRunFunctionPassManager(FPM, F));
2535 }
2536
2537 /* [ `Function ] PassManager.t -> bool */
2538 CAMLprim value llvm_passmanager_finalize(LLVMPassManagerRef FPM) {
2539   return Val_bool(LLVMFinalizeFunctionPassManager(FPM));
2540 }
2541
2542 /* PassManager.any PassManager.t -> unit */
2543 CAMLprim value llvm_passmanager_dispose(LLVMPassManagerRef PM) {
2544   LLVMDisposePassManager(PM);
2545   return Val_unit;
2546 }