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