bindings/ocaml/llvm/llvm_ocaml.c

   1 /*===-- llvm_ocaml.h - LLVM Ocaml Glue --------------------------*- C++ -*-===*\
   2 |*                                                                            *|
   3 |*                     The LLVM Compiler Infrastructure                       *|
   4 |*                                                                            *|
   5 |* This file was developed by Gordon Henriksen and is distributed under the   *|
   6 |* University of Illinois Open Source 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/mlvalues.h"
  22 #include "caml/memory.h"
  23 #include "llvm/Config/config.h"
  24 #include <assert.h>
  25
  26
  27 /*===-- Modules -----------------------------------------------------------===*/
  28
  29 /* string -> llmodule */
  30 CAMLprim LLVMModuleRef llvm_create_module(value ModuleID) {
  31   return LLVMModuleCreateWithName(String_val(ModuleID));
  32 }
  33
  34 /* llmodule -> unit */
  35 CAMLprim value llvm_dispose_module(LLVMModuleRef M) {
  36   LLVMDisposeModule(M);
  37   return Val_unit;
  38 }
  39
  40 /* string -> lltype -> llmodule -> bool */
  41 CAMLprim value llvm_add_type_name(value Name, LLVMTypeRef Ty, LLVMModuleRef M) {
  42   int res = LLVMAddTypeName(M, String_val(Name), Ty);
  43   return Val_bool(res == 0);
  44 }
  45
  46 /* string -> llmodule -> unit */
  47 CAMLprim value llvm_delete_type_name(value Name, LLVMModuleRef M) {
  48   LLVMDeleteTypeName(M, String_val(Name));
  49   return Val_unit;
  50 }
  51
  52
  53 /*===-- Types -------------------------------------------------------------===*/
  54
  55 /* lltype -> type_kind */
  56 CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
  57   return Val_int(LLVMGetTypeKind(Ty));
  58 }
  59
  60 /* lltype -> lltype -> unit */
  61 CAMLprim value llvm_refine_abstract_type(LLVMTypeRef ConcreteTy,
  62                                          LLVMTypeRef AbstractTy) {
  63   LLVMRefineAbstractType(AbstractTy, ConcreteTy);
  64   return Val_unit;
  65 }
  66
  67 /*--... Operations on integer types ........................................--*/
  68
  69 /* unit -> lltype */
  70 CAMLprim LLVMTypeRef llvm_i1_type (value Unit) { return LLVMInt1Type();  }
  71 CAMLprim LLVMTypeRef llvm_i8_type (value Unit) { return LLVMInt8Type();  }
  72 CAMLprim LLVMTypeRef llvm_i16_type(value Unit) { return LLVMInt16Type(); }
  73 CAMLprim LLVMTypeRef llvm_i32_type(value Unit) { return LLVMInt32Type(); }
  74 CAMLprim LLVMTypeRef llvm_i64_type(value Unit) { return LLVMInt64Type(); }
  75
  76 /* int -> lltype */
  77 CAMLprim LLVMTypeRef llvm_integer_type(value Width) {
  78   return LLVMIntType(Int_val(Width));
  79 }
  80
  81 /* lltype -> int */
  82 CAMLprim value llvm_integer_bitwidth(LLVMTypeRef IntegerTy) {
  83   return Val_int(LLVMGetIntTypeWidth(IntegerTy));
  84 }
  85
  86 /*--... Operations on real types ...........................................--*/
  87
  88 /* unit -> lltype */
  89 CAMLprim LLVMTypeRef llvm_float_type(value Unit) {
  90   return LLVMFloatType();
  91 }
  92
  93 /* unit -> lltype */
  94 CAMLprim LLVMTypeRef llvm_double_type(value Unit) {
  95   return LLVMDoubleType();
  96 }
  97
  98 /* unit -> lltype */
  99 CAMLprim LLVMTypeRef llvm_x86fp80_type(value Unit) {
 100   return LLVMX86FP80Type();
 101 }
 102
 103 /* unit -> lltype */
 104 CAMLprim LLVMTypeRef llvm_fp128_type(value Unit) {
 105   return LLVMFP128Type();
 106 }
 107
 108 /* unit -> lltype */
 109 CAMLprim LLVMTypeRef llvm_ppc_fp128_type(value Unit) {
 110   return LLVMPPCFP128Type();
 111 }
 112
 113 /*--... Operations on function types .......................................--*/
 114
 115 /* lltype -> lltype array -> lltype */
 116 CAMLprim LLVMTypeRef llvm_function_type(LLVMTypeRef RetTy, value ParamTys) {
 117   return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
 118                           Wosize_val(ParamTys), 0);
 119 }
 120
 121 /* lltype -> lltype array -> lltype */
 122 CAMLprim LLVMTypeRef llvm_var_arg_function_type(LLVMTypeRef RetTy,
 123                                                 value ParamTys) {
 124   return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
 125                           Wosize_val(ParamTys), 1);
 126 }
 127
 128 /* lltype -> bool */
 129 CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) {
 130   return Val_bool(LLVMIsFunctionVarArg(FunTy));
 131 }
 132
 133 /* lltype -> lltype array */
 134 CAMLprim value llvm_param_types(LLVMTypeRef FunTy) {
 135   value Tys = alloc(LLVMCountParamTypes(FunTy), 0);
 136   LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys);
 137   return Tys;
 138 }
 139
 140 /*--... Operations on struct types .........................................--*/
 141
 142 /* lltype array -> lltype */
 143 CAMLprim LLVMTypeRef llvm_struct_type(value ElementTypes) {
 144   return LLVMStructType((LLVMTypeRef *) ElementTypes,
 145                         Wosize_val(ElementTypes), 0);
 146 }
 147
 148 /* lltype array -> lltype */
 149 CAMLprim LLVMTypeRef llvm_packed_struct_type(value ElementTypes) {
 150   return LLVMStructType((LLVMTypeRef *) ElementTypes,
 151                         Wosize_val(ElementTypes), 1);
 152 }
 153
 154 /* lltype -> lltype array */
 155 CAMLprim value llvm_element_types(LLVMTypeRef StructTy) {
 156   value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
 157   LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys);
 158   return Tys;
 159 }
 160
 161 /* lltype -> bool */
 162 CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) {
 163   return Val_bool(LLVMIsPackedStruct(StructTy));
 164 }
 165
 166 /*--... Operations on array, pointer, and vector types .....................--*/
 167
 168 /* lltype -> int -> lltype */
 169 CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) {
 170   return LLVMArrayType(ElementTy, Int_val(Count));
 171 }
 172
 173 /* lltype -> int -> lltype */
 174 CAMLprim LLVMTypeRef llvm_vector_type(LLVMTypeRef ElementTy, value Count) {
 175   return LLVMVectorType(ElementTy, Int_val(Count));
 176 }
 177
 178 /* lltype -> int */
 179 CAMLprim value llvm_array_length(LLVMTypeRef ArrayTy) {
 180   return Val_int(LLVMGetArrayLength(ArrayTy));
 181 }
 182
 183 /* lltype -> int */
 184 CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) {
 185   return Val_int(LLVMGetVectorSize(VectorTy));
 186 }
 187
 188 /*--... Operations on other types ..........................................--*/
 189
 190 /* unit -> lltype */
 191 CAMLprim LLVMTypeRef llvm_void_type (value Unit) { return LLVMVoidType();  }
 192 CAMLprim LLVMTypeRef llvm_label_type(value Unit) { return LLVMLabelType(); }
 193
 194 /* unit -> lltype */
 195 CAMLprim LLVMTypeRef llvm_opaque_type(value Unit) {
 196   return LLVMOpaqueType();
 197 }
 198
 199 /*--... Operations on type handles .........................................--*/
 200
 201 #define Typehandle_val(v)  (*(LLVMTypeHandleRef *)(Data_custom_val(v)))
 202
 203 void llvm_finalize_handle(value TH) {
 204   LLVMDisposeTypeHandle(Typehandle_val(TH));
 205 }
 206
 207 static struct custom_operations typehandle_ops = {
 208   (char *) "LLVMTypeHandle",
 209   llvm_finalize_handle,
 210   custom_compare_default,
 211   custom_hash_default,
 212   custom_serialize_default,
 213   custom_deserialize_default
 214 };
 215
 216 CAMLprim value llvm_handle_to_type(LLVMTypeRef PATy) {
 217   value TH = alloc_custom(&typehandle_ops, sizeof(LLVMBuilderRef), 0, 1);
 218   Typehandle_val(TH) = LLVMCreateTypeHandle(PATy);
 219   return TH;
 220 }
 221
 222 CAMLprim LLVMTypeRef llvm_type_of_handle(value TH) {
 223   return LLVMResolveTypeHandle(Typehandle_val(TH));
 224 }
 225
 226 CAMLprim value llvm_refine_type(LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy){
 227   LLVMRefineAbstractType(AbstractTy, ConcreteTy);
 228   return Val_unit;
 229 }
 230
 231
 232 /*===-- VALUES ------------------------------------------------------------===*/
 233
 234 /* llvalue -> lltype */
 235 CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) {
 236   return LLVMTypeOf(Val);
 237 }
 238
 239 /* llvalue -> string */
 240 CAMLprim value llvm_value_name(LLVMValueRef Val) {
 241   return copy_string(LLVMGetValueName(Val));
 242 }
 243
 244 /* string -> llvalue -> unit */
 245 CAMLprim value llvm_set_value_name(value Name, LLVMValueRef Val) {
 246   LLVMSetValueName(Val, String_val(Name));
 247   return Val_unit;
 248 }
 249
 250 /* llvalue -> unit */
 251 CAMLprim value llvm_dump_value(LLVMValueRef Val) {
 252   LLVMDumpValue(Val);
 253   return Val_unit;
 254 }
 255
 256 /*--... Operations on constants of (mostly) any type .......................--*/
 257
 258 /* llvalue -> bool */
 259 CAMLprim value llvm_is_constant(LLVMValueRef Val) {
 260   return Val_bool(LLVMIsConstant(Val));
 261 }
 262
 263 /* llvalue -> bool */
 264 CAMLprim value llvm_is_null(LLVMValueRef Val) {
 265   return Val_bool(LLVMIsNull(Val));
 266 }
 267
 268 /* llvalue -> bool */
 269 CAMLprim value llvm_is_undef(LLVMValueRef Val) {
 270   return Val_bool(LLVMIsUndef(Val));
 271 }
 272
 273 /*--... Operations on scalar constants .....................................--*/
 274
 275 /* lltype -> int -> llvalue */
 276 CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) {
 277   return LLVMConstInt(IntTy, (long long) Int_val(N), 1);
 278 }
 279
 280 /* lltype -> Int64.t -> bool -> llvalue */
 281 CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
 282                                           value SExt) {
 283   return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
 284 }
 285
 286 /* lltype -> float -> llvalue */
 287 CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) {
 288   return LLVMConstReal(RealTy, Double_val(N));
 289 }
 290
 291 /*--... Operations on composite constants ..................................--*/
 292
 293 /* string -> llvalue */
 294 CAMLprim LLVMValueRef llvm_const_string(value Str, value NullTerminate) {
 295   return LLVMConstString(String_val(Str), string_length(Str), 1);
 296 }
 297
 298 /* string -> llvalue */
 299 CAMLprim LLVMValueRef llvm_const_stringz(value Str, value NullTerminate) {
 300   return LLVMConstString(String_val(Str), string_length(Str), 0);
 301 }
 302
 303 /* lltype -> llvalue array -> llvalue */
 304 CAMLprim LLVMValueRef llvm_const_array(LLVMTypeRef ElementTy,
 305                                                value ElementVals) {
 306   return LLVMConstArray(ElementTy, (LLVMValueRef*) Op_val(ElementVals),
 307                         Wosize_val(ElementVals));
 308 }
 309
 310 /* llvalue array -> llvalue */
 311 CAMLprim LLVMValueRef llvm_const_struct(value ElementVals) {
 312   return LLVMConstStruct((LLVMValueRef *) Op_val(ElementVals),
 313                          Wosize_val(ElementVals), 0);
 314 }
 315
 316 /* llvalue array -> llvalue */
 317 CAMLprim LLVMValueRef llvm_const_packed_struct(value ElementVals) {
 318   return LLVMConstStruct((LLVMValueRef *) Op_val(ElementVals),
 319                          Wosize_val(ElementVals), 1);
 320 }
 321
 322 /* llvalue array -> llvalue */
 323 CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
 324   return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals),
 325                          Wosize_val(ElementVals));
 326 }
 327
 328 /*--... Constant expressions ...............................................--*/
 329
 330 /* int_predicate -> llvalue -> llvalue -> llvalue */
 331 CAMLprim LLVMValueRef llvm_const_icmp(value Pred,
 332                                       LLVMValueRef LHSConstant,
 333                                       LLVMValueRef RHSConstant) {
 334   return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant);
 335 }
 336
 337 /* real_predicate -> llvalue -> llvalue -> llvalue */
 338 CAMLprim LLVMValueRef llvm_const_fcmp(value Pred,
 339                                       LLVMValueRef LHSConstant,
 340                                       LLVMValueRef RHSConstant) {
 341   return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant);
 342 }
 343
 344 /* llvalue -> llvalue array -> llvalue */
 345 CAMLprim LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) {
 346   return LLVMConstGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
 347                       Wosize_val(Indices));
 348 }
 349
 350 /*--... Operations on global variables, functions, and aliases (globals) ...--*/
 351
 352 /* llvalue -> bool */
 353 CAMLprim value llvm_is_declaration(LLVMValueRef Global) {
 354   return Val_bool(LLVMIsDeclaration(Global));
 355 }
 356
 357 /* llvalue -> linkage */
 358 CAMLprim value llvm_linkage(LLVMValueRef Global) {
 359   return Val_int(LLVMGetLinkage(Global));
 360 }
 361
 362 /* linkage -> llvalue -> unit */
 363 CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) {
 364   LLVMSetLinkage(Global, Int_val(Linkage));
 365   return Val_unit;
 366 }
 367
 368 /* llvalue -> string */
 369 CAMLprim value llvm_section(LLVMValueRef Global) {
 370   return copy_string(LLVMGetSection(Global));
 371 }
 372
 373 /* string -> llvalue -> unit */
 374 CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) {
 375   LLVMSetSection(Global, String_val(Section));
 376   return Val_unit;
 377 }
 378
 379 /* llvalue -> visibility */
 380 CAMLprim value llvm_visibility(LLVMValueRef Global) {
 381   return Val_int(LLVMGetVisibility(Global));
 382 }
 383
 384 /* visibility -> llvalue -> unit */
 385 CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) {
 386   LLVMSetVisibility(Global, Int_val(Viz));
 387   return Val_unit;
 388 }
 389
 390 /* llvalue -> int */
 391 CAMLprim value llvm_alignment(LLVMValueRef Global) {
 392   return Val_int(LLVMGetAlignment(Global));
 393 }
 394
 395 /* int -> llvalue -> unit */
 396 CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
 397   LLVMSetAlignment(Global, Int_val(Bytes));
 398   return Val_unit;
 399 }
 400
 401 /*--... Operations on global variables .....................................--*/
 402
 403 /* lltype -> string -> llmodule -> llvalue */
 404 CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
 405                                           LLVMModuleRef M) {
 406   LLVMValueRef GlobalVar;
 407   if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
 408     if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
 409       return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty));
 410     return GlobalVar;
 411   }
 412   return LLVMAddGlobal(M, Ty, String_val(Name));
 413 }
 414
 415 /* string -> llmodule -> llvalue option */
 416 CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
 417   CAMLparam1(Name);
 418   LLVMValueRef GlobalVar;
 419   if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
 420     value Option = alloc(1, 1);
 421     Field(Option, 0) = (value) GlobalVar;
 422     CAMLreturn(Option);
 423   }
 424   CAMLreturn(Val_int(0));
 425 }
 426
 427 /* string -> llvalue -> llmodule -> llvalue */
 428 CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
 429                                          LLVMModuleRef M) {
 430   LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer),
 431                                          String_val(Name));
 432   LLVMSetInitializer(GlobalVar, Initializer);
 433   return GlobalVar;
 434 }
 435
 436 /* llvalue -> unit */
 437 CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) {
 438   LLVMDeleteGlobal(GlobalVar);
 439   return Val_unit;
 440 }
 441
 442 /* llvalue -> llvalue -> unit */
 443 CAMLprim value llvm_set_initializer(LLVMValueRef ConstantVal,
 444                                     LLVMValueRef GlobalVar) {
 445   LLVMSetInitializer(GlobalVar, ConstantVal);
 446   return Val_unit;
 447 }
 448
 449 /* llvalue -> unit */
 450 CAMLprim value llvm_remove_initializer(LLVMValueRef GlobalVar) {
 451   LLVMSetInitializer(GlobalVar, NULL);
 452   return Val_unit;
 453 }
 454
 455 /* llvalue -> bool */
 456 CAMLprim value llvm_is_thread_local(LLVMValueRef GlobalVar) {
 457   return Val_bool(LLVMIsThreadLocal(GlobalVar));
 458 }
 459
 460 /* bool -> llvalue -> unit */
 461 CAMLprim value llvm_set_thread_local(value IsThreadLocal,
 462                                      LLVMValueRef GlobalVar) {
 463   LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal));
 464   return Val_unit;
 465 }
 466
 467 /* llvalue -> bool */
 468 CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) {
 469   return Val_bool(LLVMIsGlobalConstant(GlobalVar));
 470 }
 471
 472 /* bool -> llvalue -> unit */
 473 CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
 474   LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag));
 475   return Val_unit;
 476 }
 477
 478 /*--... Operations on functions ............................................--*/
 479
 480 /* string -> lltype -> llmodule -> llvalue */
 481 CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
 482                                             LLVMModuleRef M) {
 483   LLVMValueRef Fn;
 484   if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
 485     if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
 486       return LLVMConstBitCast(Fn, LLVMPointerType(Ty));
 487     return Fn;
 488   }
 489   return LLVMAddFunction(M, String_val(Name), Ty);
 490 }
 491
 492 /* string -> llmodule -> llvalue option */
 493 CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
 494   CAMLparam1(Name);
 495   LLVMValueRef Fn;
 496   if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
 497     value Option = alloc(1, 1);
 498     Field(Option, 0) = (value) Fn;
 499     CAMLreturn(Option);
 500   }
 501   CAMLreturn(Val_int(0));
 502 }
 503
 504 /* string -> lltype -> llmodule -> llvalue */
 505 CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
 506                                            LLVMModuleRef M) {
 507   LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
 508   LLVMAppendBasicBlock(Fn, "entry");
 509   return Fn;
 510 }
 511
 512 /* llvalue -> unit */
 513 CAMLprim value llvm_delete_function(LLVMValueRef Fn) {
 514   LLVMDeleteFunction(Fn);
 515   return Val_unit;
 516 }
 517
 518 /* llvalue -> int -> llvalue */
 519 CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
 520   return LLVMGetParam(Fn, Int_val(Index));
 521 }
 522
 523 /* llvalue -> int -> llvalue */
 524 CAMLprim value llvm_params(LLVMValueRef Fn, value Index) {
 525   value Params = alloc(LLVMCountParams(Fn), 0);
 526   LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
 527   return Params;
 528 }
 529
 530 /* llvalue -> bool */
 531 CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) {
 532   return Val_bool(LLVMGetIntrinsicID(Fn));
 533 }
 534
 535 /* llvalue -> int */
 536 CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) {
 537   return Val_int(LLVMGetFunctionCallConv(Fn));
 538 }
 539
 540 /* int -> llvalue -> unit */
 541 CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) {
 542   LLVMSetFunctionCallConv(Fn, Int_val(Id));
 543   return Val_unit;
 544 }
 545
 546 /*--... Operations on basic blocks .........................................--*/
 547
 548 /* llvalue -> llbasicblock array */
 549 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
 550   value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
 551   LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
 552   return MLArray;
 553 }
 554
 555 /* llbasicblock -> unit */
 556 CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
 557   LLVMDeleteBasicBlock(BB);
 558   return Val_unit;
 559 }
 560
 561 /* string -> llvalue -> llbasicblock */
 562 CAMLprim LLVMBasicBlockRef llvm_append_block(value Name, LLVMValueRef Fn) {
 563   return LLVMAppendBasicBlock(Fn, String_val(Name));
 564 }
 565
 566 /* string -> llbasicblock -> llbasicblock */
 567 CAMLprim LLVMBasicBlockRef llvm_insert_block(value Name, LLVMBasicBlockRef BB) {
 568   return LLVMInsertBasicBlock(BB, String_val(Name));
 569 }
 570
 571 /* llvalue -> bool */
 572 CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
 573   return Val_bool(LLVMValueIsBasicBlock(Val));
 574 }
 575
 576 /*--... Operations on phi nodes ............................................--*/
 577
 578 /* (llvalue * llbasicblock) -> llvalue -> unit */
 579 CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
 580   LLVMAddIncoming(PhiNode,
 581                   (LLVMValueRef*) &Field(Incoming, 0),
 582                   (LLVMBasicBlockRef*) &Field(Incoming, 1),
 583                   1);
 584   return Val_unit;
 585 }
 586
 587 /* llvalue -> (llvalue * llbasicblock) list */
 588 CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
 589   unsigned I;
 590   CAMLparam0();
 591   CAMLlocal3(Hd, Tl, Tmp);
 592
 593   /* Build a tuple list of them. */
 594   Tl = Val_int(0);
 595   for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
 596     Hd = alloc(2, 0);
 597     Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
 598     Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
 599
 600     Tmp = alloc(2, 0);
 601     Store_field(Tmp, 0, Hd);
 602     Store_field(Tmp, 1, Tl);
 603     Tl = Tmp;
 604   }
 605
 606   CAMLreturn(Tl);
 607 }
 608
 609
 610 /*===-- Instruction builders ----------------------------------------------===*/
 611
 612 #define Builder_val(v)  (*(LLVMBuilderRef *)(Data_custom_val(v)))
 613
 614 void llvm_finalize_builder(value B) {
 615   LLVMDisposeBuilder(Builder_val(B));
 616 }
 617
 618 static struct custom_operations builder_ops = {
 619   (char *) "LLVMBuilder",
 620   llvm_finalize_builder,
 621   custom_compare_default,
 622   custom_hash_default,
 623   custom_serialize_default,
 624   custom_deserialize_default
 625 };
 626
 627 /* llvalue -> llbuilder */
 628 CAMLprim value llvm_builder_before(LLVMValueRef Inst) {
 629   value V;
 630   LLVMBuilderRef B = LLVMCreateBuilder();
 631   LLVMPositionBuilderBefore(B, Inst);
 632   V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
 633   Builder_val(V) = B;
 634   return V;
 635 }
 636
 637 /* llbasicblock -> llbuilder */
 638 CAMLprim value llvm_builder_at_end(LLVMBasicBlockRef BB) {
 639   value V;
 640   LLVMBuilderRef B = LLVMCreateBuilder();
 641   LLVMPositionBuilderAtEnd(B, BB);
 642   V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
 643   Builder_val(V) = B;
 644   return V;
 645 }
 646
 647 /* llvalue -> llbuilder -> unit */
 648 CAMLprim value llvm_position_before(LLVMValueRef Inst, value B) {
 649   LLVMPositionBuilderBefore(Builder_val(B), Inst);
 650   return Val_unit;
 651 }
 652
 653 /* llbasicblock -> llbuilder -> unit */
 654 CAMLprim value llvm_position_at_end(LLVMBasicBlockRef BB, value B) {
 655   LLVMPositionBuilderAtEnd(Builder_val(B), BB);
 656   return Val_unit;
 657 }
 658
 659 /*--... Terminators ........................................................--*/
 660
 661 /* llbuilder -> llvalue */
 662 CAMLprim LLVMValueRef llvm_build_ret_void(value B) {
 663   return LLVMBuildRetVoid(Builder_val(B));
 664 }
 665
 666 /* llvalue -> llbuilder -> llvalue */
 667 CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) {
 668   return LLVMBuildRet(Builder_val(B), Val);
 669 }
 670
 671 /* llbasicblock -> llbuilder -> llvalue */
 672 CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) {
 673   return LLVMBuildBr(Builder_val(B), BB);
 674 }
 675
 676 /* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */
 677 CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If,
 678                                          LLVMBasicBlockRef Then,
 679                                          LLVMBasicBlockRef Else,
 680                                          value B) {
 681   return LLVMBuildCondBr(Builder_val(B), If, Then, Else);
 682 }
 683
 684 /* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */
 685 CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
 686                                         LLVMBasicBlockRef Else,
 687                                         value EstimatedCount,
 688                                         value B) {
 689   return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
 690 }
 691
 692 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
 693    llbuilder -> llvalue */
 694 CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
 695                                             LLVMBasicBlockRef Then,
 696                                             LLVMBasicBlockRef Catch,
 697                                             value Name, value B) {
 698   return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Args),
 699                          Wosize_val(Args), Then, Catch, String_val(Name));
 700 }
 701
 702 /* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
 703    llbuilder -> llvalue */
 704 CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
 705   return llvm_build_invoke_nat((LLVMValueRef) Args[0], Args[1],
 706                                (LLVMBasicBlockRef) Args[2],
 707                                (LLVMBasicBlockRef) Args[3],
 708                                Args[4], Args[5]);
 709 }
 710
 711 /* llbuilder -> llvalue */
 712 CAMLprim LLVMValueRef llvm_build_unwind(value B) {
 713   return LLVMBuildUnwind(Builder_val(B));
 714 }
 715
 716 /* llbuilder -> llvalue */
 717 CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
 718   return LLVMBuildUnreachable(Builder_val(B));
 719 }
 720
 721 /*--... Arithmetic .........................................................--*/
 722
 723 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 724 CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS,
 725                                      value Name, value B) {
 726   return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name));
 727 }
 728
 729 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 730 CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS,
 731                                      value Name, value B) {
 732   return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name));
 733 }
 734
 735 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 736 CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS,
 737                                      value Name, value B) {
 738   return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name));
 739 }
 740
 741 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 742 CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS,
 743                                       value Name, value B) {
 744   return LLVMBuildUDiv(Builder_val(B), LHS, RHS, String_val(Name));
 745 }
 746
 747 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 748 CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
 749                                       value Name, value B) {
 750   return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name));
 751 }
 752
 753 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 754 CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS,
 755                                       value Name, value B) {
 756   return LLVMBuildFDiv(Builder_val(B), LHS, RHS, String_val(Name));
 757 }
 758
 759 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 760 CAMLprim LLVMValueRef llvm_build_urem(LLVMValueRef LHS, LLVMValueRef RHS,
 761                                       value Name, value B) {
 762   return LLVMBuildURem(Builder_val(B), LHS, RHS, String_val(Name));
 763 }
 764
 765 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 766 CAMLprim LLVMValueRef llvm_build_srem(LLVMValueRef LHS, LLVMValueRef RHS,
 767                                       value Name, value B) {
 768   return LLVMBuildSRem(Builder_val(B), LHS, RHS, String_val(Name));
 769 }
 770
 771 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 772 CAMLprim LLVMValueRef llvm_build_frem(LLVMValueRef LHS, LLVMValueRef RHS,
 773                                       value Name, value B) {
 774   return LLVMBuildFRem(Builder_val(B), LHS, RHS, String_val(Name));
 775 }
 776
 777 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 778 CAMLprim LLVMValueRef llvm_build_shl(LLVMValueRef LHS, LLVMValueRef RHS,
 779                                      value Name, value B) {
 780   return LLVMBuildShl(Builder_val(B), LHS, RHS, String_val(Name));
 781 }
 782
 783 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 784 CAMLprim LLVMValueRef llvm_build_lshr(LLVMValueRef LHS, LLVMValueRef RHS,
 785                                       value Name, value B) {
 786   return LLVMBuildLShr(Builder_val(B), LHS, RHS, String_val(Name));
 787 }
 788
 789 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 790 CAMLprim LLVMValueRef llvm_build_ashr(LLVMValueRef LHS, LLVMValueRef RHS,
 791                                       value Name, value B) {
 792   return LLVMBuildAShr(Builder_val(B), LHS, RHS, String_val(Name));
 793 }
 794
 795 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 796 CAMLprim LLVMValueRef llvm_build_and(LLVMValueRef LHS, LLVMValueRef RHS,
 797                                      value Name, value B) {
 798   return LLVMBuildAnd(Builder_val(B), LHS, RHS, String_val(Name));
 799 }
 800
 801 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 802 CAMLprim LLVMValueRef llvm_build_or(LLVMValueRef LHS, LLVMValueRef RHS,
 803                                     value Name, value B) {
 804   return LLVMBuildOr(Builder_val(B), LHS, RHS, String_val(Name));
 805 }
 806
 807 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
 808 CAMLprim LLVMValueRef llvm_build_xor(LLVMValueRef LHS, LLVMValueRef RHS,
 809                                      value Name, value B) {
 810   return LLVMBuildXor(Builder_val(B), LHS, RHS, String_val(Name));
 811 }
 812
 813 /* llvalue -> string -> llbuilder -> llvalue */
 814 CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X,
 815                                      value Name, value B) {
 816   return LLVMBuildNeg(Builder_val(B), X, String_val(Name));
 817 }
 818
 819 /* llvalue -> string -> llbuilder -> llvalue */
 820 CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X,
 821                                      value Name, value B) {
 822   return LLVMBuildNot(Builder_val(B), X, String_val(Name));
 823 }
 824
 825 /*--... Memory .............................................................--*/
 826
 827 /* lltype -> string -> llbuilder -> llvalue */
 828 CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty,
 829                                         value Name, value B) {
 830   return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
 831 }
 832
 833 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
 834 CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty, LLVMValueRef Size,
 835                                               value Name, value B) {
 836   return LLVMBuildArrayMalloc(Builder_val(B), Ty, Size, String_val(Name));
 837 }
 838
 839 /* lltype -> string -> llbuilder -> llvalue */
 840 CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty,
 841                                         value Name, value B) {
 842   return LLVMBuildAlloca(Builder_val(B), Ty, String_val(Name));
 843 }
 844
 845 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
 846 CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size,
 847                                               value Name, value B) {
 848   return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name));
 849 }
 850
 851 /* llvalue -> llbuilder -> llvalue */
 852 CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef Pointer, value B) {
 853   return LLVMBuildFree(Builder_val(B), Pointer);
 854 }
 855
 856 /* llvalue -> string -> llbuilder -> llvalue */
 857 CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer,
 858                                       value Name, value B) {
 859   return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name));
 860 }
 861
 862 /* llvalue -> llvalue -> llbuilder -> llvalue */
 863 CAMLprim LLVMValueRef llvm_build_store(LLVMValueRef Value, LLVMValueRef Pointer,
 864                                        value B) {
 865   return LLVMBuildStore(Builder_val(B), Value, Pointer);
 866 }
 867
 868 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
 869 CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices,
 870                                      value Name, value B) {
 871   return LLVMBuildGEP(Builder_val(B), Pointer,
 872                       (LLVMValueRef *) Op_val(Indices), Wosize_val(Indices),
 873                       String_val(Name));
 874 }
 875
 876 /*--... Casts ..............................................................--*/
 877
 878 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 879 CAMLprim LLVMValueRef llvm_build_trunc(LLVMValueRef X, LLVMTypeRef Ty,
 880                                        value Name, value B) {
 881   return LLVMBuildTrunc(Builder_val(B), X, Ty, String_val(Name));
 882 }
 883
 884 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 885 CAMLprim LLVMValueRef llvm_build_zext(LLVMValueRef X, LLVMTypeRef Ty,
 886                                       value Name, value B) {
 887   return LLVMBuildZExt(Builder_val(B), X, Ty, String_val(Name));
 888 }
 889
 890 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 891 CAMLprim LLVMValueRef llvm_build_sext(LLVMValueRef X, LLVMTypeRef Ty,
 892                                       value Name, value B) {
 893   return LLVMBuildSExt(Builder_val(B), X, Ty, String_val(Name));
 894 }
 895
 896 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 897 CAMLprim LLVMValueRef llvm_build_fptoui(LLVMValueRef X, LLVMTypeRef Ty,
 898                                         value Name, value B) {
 899   return LLVMBuildFPToUI(Builder_val(B), X, Ty, String_val(Name));
 900 }
 901
 902 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 903 CAMLprim LLVMValueRef llvm_build_fptosi(LLVMValueRef X, LLVMTypeRef Ty,
 904                                         value Name, value B) {
 905   return LLVMBuildFPToSI(Builder_val(B), X, Ty, String_val(Name));
 906 }
 907
 908 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 909 CAMLprim LLVMValueRef llvm_build_uitofp(LLVMValueRef X, LLVMTypeRef Ty,
 910                                         value Name, value B) {
 911   return LLVMBuildUIToFP(Builder_val(B), X, Ty, String_val(Name));
 912 }
 913
 914 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 915 CAMLprim LLVMValueRef llvm_build_sitofp(LLVMValueRef X, LLVMTypeRef Ty,
 916                                         value Name, value B) {
 917   return LLVMBuildSIToFP(Builder_val(B), X, Ty, String_val(Name));
 918 }
 919
 920 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 921 CAMLprim LLVMValueRef llvm_build_fptrunc(LLVMValueRef X, LLVMTypeRef Ty,
 922                                          value Name, value B) {
 923   return LLVMBuildFPTrunc(Builder_val(B), X, Ty, String_val(Name));
 924 }
 925
 926 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 927 CAMLprim LLVMValueRef llvm_build_fpext(LLVMValueRef X, LLVMTypeRef Ty,
 928                                        value Name, value B) {
 929   return LLVMBuildFPExt(Builder_val(B), X, Ty, String_val(Name));
 930 }
 931
 932 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 933 CAMLprim LLVMValueRef llvm_build_prttoint(LLVMValueRef X, LLVMTypeRef Ty,
 934                                           value Name, value B) {
 935   return LLVMBuildPtrToInt(Builder_val(B), X, Ty, String_val(Name));
 936 }
 937
 938 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 939 CAMLprim LLVMValueRef llvm_build_inttoptr(LLVMValueRef X, LLVMTypeRef Ty,
 940                                           value Name, value B) {
 941   return LLVMBuildIntToPtr(Builder_val(B), X, Ty, String_val(Name));
 942 }
 943
 944 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
 945 CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
 946                                          value Name, value B) {
 947   return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name));
 948 }
 949
 950 /*--... Comparisons ........................................................--*/
 951
 952 /* int_predicate -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
 953 CAMLprim LLVMValueRef llvm_build_icmp(value Pred,
 954                                       LLVMValueRef LHS, LLVMValueRef RHS,
 955                                       value Name, value B) {
 956   return LLVMBuildICmp(Builder_val(B), Int_val(Pred) + LLVMIntEQ, LHS, RHS,
 957                        String_val(Name));
 958 }
 959
 960 /* real_predicate -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
 961 CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
 962                                       LLVMValueRef LHS, LLVMValueRef RHS,
 963                                       value Name, value B) {
 964   return LLVMBuildFCmp(Builder_val(B), Int_val(Pred), LHS, RHS,
 965                        String_val(Name));
 966 }
 967
 968 /*--... Miscellaneous instructions .........................................--*/
 969
 970 /* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */
 971 CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
 972   value Hd, Tl;
 973   LLVMValueRef FirstValue, PhiNode;
 974
 975   assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
 976
 977   Hd = Field(Incoming, 0);
 978   FirstValue = (LLVMValueRef) Field(Hd, 0);
 979   PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
 980                          String_val(Name));
 981
 982   for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) {
 983     value Hd = Field(Tl, 0);
 984     LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
 985                     (LLVMBasicBlockRef*) &Field(Hd, 1), 1);
 986   }
 987
 988   return PhiNode;
 989 }
 990
 991 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
 992 CAMLprim LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params,
 993                                       value Name, value B) {
 994   return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Params),
 995                        Wosize_val(Params), String_val(Name));
 996 }
 997
 998 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
 999 CAMLprim LLVMValueRef llvm_build_select(LLVMValueRef If,
1000                                         LLVMValueRef Then, LLVMValueRef Else,
1001                                         value Name, value B) {
1002   return LLVMBuildSelect(Builder_val(B), If, Then, Else, String_val(Name));
1003 }
1004
1005 /* llvalue -> lltype -> string -> llbuilder -> llvalue */
1006 CAMLprim LLVMValueRef llvm_build_va_arg(LLVMValueRef List, LLVMTypeRef Ty,
1007                                         value Name, value B) {
1008   return LLVMBuildVAArg(Builder_val(B), List, Ty, String_val(Name));
1009 }
1010
1011 /* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1012 CAMLprim LLVMValueRef llvm_build_extractelement(LLVMValueRef Vec,
1013                                                 LLVMValueRef Idx,
1014                                                 value Name, value B) {
1015   return LLVMBuildExtractElement(Builder_val(B), Vec, Idx, String_val(Name));
1016 }
1017
1018 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1019 CAMLprim LLVMValueRef llvm_build_insertelement(LLVMValueRef Vec,
1020                                                LLVMValueRef Element,
1021                                                LLVMValueRef Idx,
1022                                                value Name, value B) {
1023   return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx,
1024                                 String_val(Name));
1025 }
1026
1027 /* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
1028 CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2,
1029                                                LLVMValueRef Mask,
1030                                                value Name, value B) {
1031   return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name));
1032 }
1033