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