llvm_ocaml.c revision c59286bff1cca8c4fa15f390c9002db94117614e
1/*===-- llvm_ocaml.c - LLVM Ocaml Glue --------------------------*- C++ -*-===*\ 2|* *| 3|* The LLVM Compiler Infrastructure *| 4|* *| 5|* This file is distributed under the University of Illinois Open Source *| 6|* License. See LICENSE.TXT for details. *| 7|* *| 8|*===----------------------------------------------------------------------===*| 9|* *| 10|* This file glues LLVM's ocaml interface to its C interface. These functions *| 11|* are by and large transparent wrappers to the corresponding C functions. *| 12|* *| 13|* Note that these functions intentionally take liberties with the CAMLparamX *| 14|* macros, since most of the parameters are not GC heap objects. *| 15|* *| 16\*===----------------------------------------------------------------------===*/ 17 18#include "llvm-c/Core.h" 19#include "caml/alloc.h" 20#include "caml/custom.h" 21#include "caml/memory.h" 22#include "caml/fail.h" 23#include "caml/callback.h" 24#include "llvm/Config/config.h" 25#include <assert.h> 26#include <stdlib.h> 27 28 29/* Can't use the recommended caml_named_value mechanism for backwards 30 compatibility reasons. This is largely equivalent. */ 31static value llvm_ioerror_exn; 32 33CAMLprim 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 39static 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 53static 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 */ 98CAMLprim LLVMContextRef llvm_create_context(value Unit) { 99 return LLVMContextCreate(); 100} 101 102/* llcontext -> unit */ 103CAMLprim value llvm_dispose_context(LLVMContextRef C) { 104 LLVMContextDispose(C); 105 return Val_unit; 106} 107 108/* unit -> llcontext */ 109CAMLprim LLVMContextRef llvm_global_context(value Unit) { 110 return LLVMGetGlobalContext(); 111} 112 113/* llcontext -> string -> int */ 114CAMLprim 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 */ 123CAMLprim LLVMModuleRef llvm_create_module(LLVMContextRef C, value ModuleID) { 124 return LLVMModuleCreateWithNameInContext(String_val(ModuleID), C); 125} 126 127/* llmodule -> unit */ 128CAMLprim value llvm_dispose_module(LLVMModuleRef M) { 129 LLVMDisposeModule(M); 130 return Val_unit; 131} 132 133/* llmodule -> string */ 134CAMLprim value llvm_target_triple(LLVMModuleRef M) { 135 return copy_string(LLVMGetTarget(M)); 136} 137 138/* string -> llmodule -> unit */ 139CAMLprim value llvm_set_target_triple(value Trip, LLVMModuleRef M) { 140 LLVMSetTarget(M, String_val(Trip)); 141 return Val_unit; 142} 143 144/* llmodule -> string */ 145CAMLprim value llvm_data_layout(LLVMModuleRef M) { 146 return copy_string(LLVMGetDataLayout(M)); 147} 148 149/* string -> llmodule -> unit */ 150CAMLprim value llvm_set_data_layout(value Layout, LLVMModuleRef M) { 151 LLVMSetDataLayout(M, String_val(Layout)); 152 return Val_unit; 153} 154 155/* string -> lltype -> llmodule -> bool */ 156CAMLprim value llvm_add_type_name(value Name, LLVMTypeRef Ty, LLVMModuleRef M) { 157 int res = LLVMAddTypeName(M, String_val(Name), Ty); 158 return Val_bool(res == 0); 159} 160 161/* string -> llmodule -> unit */ 162CAMLprim value llvm_delete_type_name(value Name, LLVMModuleRef M) { 163 LLVMDeleteTypeName(M, String_val(Name)); 164 return Val_unit; 165} 166 167/* llmodule -> unit */ 168CAMLprim value llvm_dump_module(LLVMModuleRef M) { 169 LLVMDumpModule(M); 170 return Val_unit; 171} 172 173 174/*===-- Types -------------------------------------------------------------===*/ 175 176/* lltype -> TypeKind.t */ 177CAMLprim value llvm_classify_type(LLVMTypeRef Ty) { 178 return Val_int(LLVMGetTypeKind(Ty)); 179} 180 181/* lltype -> llcontext */ 182CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) { 183 return LLVMGetTypeContext(Ty); 184} 185 186/*--... Operations on integer types ........................................--*/ 187 188/* llcontext -> lltype */ 189CAMLprim LLVMTypeRef llvm_i1_type (LLVMContextRef Context) { 190 return LLVMInt1TypeInContext(Context); 191} 192 193/* llcontext -> lltype */ 194CAMLprim LLVMTypeRef llvm_i8_type (LLVMContextRef Context) { 195 return LLVMInt8TypeInContext(Context); 196} 197 198/* llcontext -> lltype */ 199CAMLprim LLVMTypeRef llvm_i16_type (LLVMContextRef Context) { 200 return LLVMInt16TypeInContext(Context); 201} 202 203/* llcontext -> lltype */ 204CAMLprim LLVMTypeRef llvm_i32_type (LLVMContextRef Context) { 205 return LLVMInt32TypeInContext(Context); 206} 207 208/* llcontext -> lltype */ 209CAMLprim LLVMTypeRef llvm_i64_type (LLVMContextRef Context) { 210 return LLVMInt64TypeInContext(Context); 211} 212 213/* llcontext -> int -> lltype */ 214CAMLprim LLVMTypeRef llvm_integer_type(LLVMContextRef Context, value Width) { 215 return LLVMIntTypeInContext(Context, Int_val(Width)); 216} 217 218/* lltype -> int */ 219CAMLprim value llvm_integer_bitwidth(LLVMTypeRef IntegerTy) { 220 return Val_int(LLVMGetIntTypeWidth(IntegerTy)); 221} 222 223/*--... Operations on real types ...........................................--*/ 224 225/* llcontext -> lltype */ 226CAMLprim LLVMTypeRef llvm_float_type(LLVMContextRef Context) { 227 return LLVMFloatTypeInContext(Context); 228} 229 230/* llcontext -> lltype */ 231CAMLprim LLVMTypeRef llvm_double_type(LLVMContextRef Context) { 232 return LLVMDoubleTypeInContext(Context); 233} 234 235/* llcontext -> lltype */ 236CAMLprim LLVMTypeRef llvm_x86fp80_type(LLVMContextRef Context) { 237 return LLVMX86FP80TypeInContext(Context); 238} 239 240/* llcontext -> lltype */ 241CAMLprim LLVMTypeRef llvm_fp128_type(LLVMContextRef Context) { 242 return LLVMFP128TypeInContext(Context); 243} 244 245/* llcontext -> lltype */ 246CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) { 247 return LLVMPPCFP128TypeInContext(Context); 248} 249 250/*--... Operations on function types .......................................--*/ 251 252/* lltype -> lltype array -> lltype */ 253CAMLprim LLVMTypeRef llvm_function_type(LLVMTypeRef RetTy, value ParamTys) { 254 return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys, 255 Wosize_val(ParamTys), 0); 256} 257 258/* lltype -> lltype array -> lltype */ 259CAMLprim LLVMTypeRef llvm_var_arg_function_type(LLVMTypeRef RetTy, 260 value ParamTys) { 261 return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys, 262 Wosize_val(ParamTys), 1); 263} 264 265/* lltype -> bool */ 266CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) { 267 return Val_bool(LLVMIsFunctionVarArg(FunTy)); 268} 269 270/* lltype -> lltype array */ 271CAMLprim value llvm_param_types(LLVMTypeRef FunTy) { 272 value Tys = alloc(LLVMCountParamTypes(FunTy), 0); 273 LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys); 274 return Tys; 275} 276 277/*--... Operations on struct types .........................................--*/ 278 279/* llcontext -> lltype array -> lltype */ 280CAMLprim LLVMTypeRef llvm_struct_type(LLVMContextRef C, value ElementTypes) { 281 return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes, 282 Wosize_val(ElementTypes), 0); 283} 284 285/* llcontext -> lltype array -> lltype */ 286CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C, 287 value ElementTypes) { 288 return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes, 289 Wosize_val(ElementTypes), 1); 290} 291 292/* lltype -> lltype array */ 293CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) { 294 value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0); 295 LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys); 296 return Tys; 297} 298 299/* lltype -> bool */ 300CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) { 301 return Val_bool(LLVMIsPackedStruct(StructTy)); 302} 303 304/*--... Operations on union types ..........................................--*/ 305 306/* llcontext -> lltype array -> lltype */ 307CAMLprim LLVMTypeRef llvm_union_type(LLVMContextRef C, value ElementTypes) { 308 return LLVMUnionTypeInContext(C, (LLVMTypeRef *) ElementTypes, 309 Wosize_val(ElementTypes)); 310} 311 312/* lltype -> lltype array */ 313CAMLprim value llvm_union_element_types(LLVMTypeRef UnionTy) { 314 value Tys = alloc(LLVMCountUnionElementTypes(UnionTy), 0); 315 LLVMGetUnionElementTypes(UnionTy, (LLVMTypeRef *) Tys); 316 return Tys; 317} 318 319/*--... Operations on array, pointer, and vector types .....................--*/ 320 321/* lltype -> int -> lltype */ 322CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) { 323 return LLVMArrayType(ElementTy, Int_val(Count)); 324} 325 326/* lltype -> lltype */ 327CAMLprim LLVMTypeRef llvm_pointer_type(LLVMTypeRef ElementTy) { 328 return LLVMPointerType(ElementTy, 0); 329} 330 331/* lltype -> int -> lltype */ 332CAMLprim LLVMTypeRef llvm_qualified_pointer_type(LLVMTypeRef ElementTy, 333 value AddressSpace) { 334 return LLVMPointerType(ElementTy, Int_val(AddressSpace)); 335} 336 337/* lltype -> int -> lltype */ 338CAMLprim LLVMTypeRef llvm_vector_type(LLVMTypeRef ElementTy, value Count) { 339 return LLVMVectorType(ElementTy, Int_val(Count)); 340} 341 342/* lltype -> int */ 343CAMLprim value llvm_array_length(LLVMTypeRef ArrayTy) { 344 return Val_int(LLVMGetArrayLength(ArrayTy)); 345} 346 347/* lltype -> int */ 348CAMLprim value llvm_address_space(LLVMTypeRef PtrTy) { 349 return Val_int(LLVMGetPointerAddressSpace(PtrTy)); 350} 351 352/* lltype -> int */ 353CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) { 354 return Val_int(LLVMGetVectorSize(VectorTy)); 355} 356 357/*--... Operations on other types ..........................................--*/ 358 359/* llcontext -> lltype */ 360CAMLprim LLVMTypeRef llvm_void_type (LLVMContextRef Context) { 361 return LLVMVoidTypeInContext(Context); 362} 363 364/* llcontext -> lltype */ 365CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) { 366 return LLVMLabelTypeInContext(Context); 367} 368 369/* llcontext -> lltype */ 370CAMLprim LLVMTypeRef llvm_opaque_type(LLVMContextRef Context) { 371 return LLVMOpaqueTypeInContext(Context); 372} 373 374/*--... Operations on type handles .........................................--*/ 375 376#define Typehandle_val(v) (*(LLVMTypeHandleRef *)(Data_custom_val(v))) 377 378static void llvm_finalize_handle(value TH) { 379 LLVMDisposeTypeHandle(Typehandle_val(TH)); 380} 381 382static struct custom_operations typehandle_ops = { 383 (char *) "LLVMTypeHandle", 384 llvm_finalize_handle, 385 custom_compare_default, 386 custom_hash_default, 387 custom_serialize_default, 388 custom_deserialize_default 389}; 390 391CAMLprim value llvm_handle_to_type(LLVMTypeRef PATy) { 392 value TH = alloc_custom(&typehandle_ops, sizeof(LLVMBuilderRef), 0, 1); 393 Typehandle_val(TH) = LLVMCreateTypeHandle(PATy); 394 return TH; 395} 396 397CAMLprim LLVMTypeRef llvm_type_of_handle(value TH) { 398 return LLVMResolveTypeHandle(Typehandle_val(TH)); 399} 400 401CAMLprim value llvm_refine_type(LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy){ 402 LLVMRefineType(AbstractTy, ConcreteTy); 403 return Val_unit; 404} 405 406 407/*===-- VALUES ------------------------------------------------------------===*/ 408 409/* llvalue -> lltype */ 410CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) { 411 return LLVMTypeOf(Val); 412} 413 414/* llvalue -> string */ 415CAMLprim value llvm_value_name(LLVMValueRef Val) { 416 return copy_string(LLVMGetValueName(Val)); 417} 418 419/* string -> llvalue -> unit */ 420CAMLprim value llvm_set_value_name(value Name, LLVMValueRef Val) { 421 LLVMSetValueName(Val, String_val(Name)); 422 return Val_unit; 423} 424 425/* llvalue -> unit */ 426CAMLprim value llvm_dump_value(LLVMValueRef Val) { 427 LLVMDumpValue(Val); 428 return Val_unit; 429} 430 431/*--... Operations on constants of (mostly) any type .......................--*/ 432 433/* llvalue -> bool */ 434CAMLprim value llvm_is_constant(LLVMValueRef Val) { 435 return Val_bool(LLVMIsConstant(Val)); 436} 437 438/* llvalue -> bool */ 439CAMLprim value llvm_is_null(LLVMValueRef Val) { 440 return Val_bool(LLVMIsNull(Val)); 441} 442 443/* llvalue -> bool */ 444CAMLprim value llvm_is_undef(LLVMValueRef Val) { 445 return Val_bool(LLVMIsUndef(Val)); 446} 447 448/*--... Operations on instructions .........................................--*/ 449 450/* llvalue -> bool */ 451CAMLprim value llvm_has_metadata(LLVMValueRef Val) { 452 return Val_bool(LLVMHasMetadata(Val)); 453} 454 455/* llvalue -> int -> llvalue option */ 456CAMLprim value llvm_metadata(LLVMValueRef Val, value MDKindID) { 457 CAMLparam1(MDKindID); 458 LLVMValueRef MD; 459 if ((MD = LLVMGetMetadata(Val, Int_val(MDKindID)))) { 460 value Option = alloc(1, 0); 461 Field(Option, 0) = (value) MD; 462 CAMLreturn(Option); 463 } 464 CAMLreturn(Val_int(0)); 465} 466 467/* llvalue -> int -> llvalue -> unit */ 468CAMLprim value llvm_set_metadata(LLVMValueRef Val, value MDKindID, 469 LLVMValueRef MD) { 470 LLVMSetMetadata(Val, Int_val(MDKindID), MD); 471 return Val_unit; 472} 473 474/* llvalue -> int -> unit */ 475CAMLprim value llvm_clear_metadata(LLVMValueRef Val, value MDKindID) { 476 LLVMSetMetadata(Val, Int_val(MDKindID), NULL); 477 return Val_unit; 478} 479 480 481/*--... Operations on metadata .............................................--*/ 482 483/* llcontext -> string -> llvalue */ 484CAMLprim LLVMValueRef llvm_mdstring(LLVMContextRef C, value S) { 485 return LLVMMDStringInContext(C, String_val(S), caml_string_length(S)); 486} 487 488/* llcontext -> llvalue array -> llvalue */ 489CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) { 490 return LLVMMDNodeInContext(C, (LLVMValueRef*) Op_val(ElementVals), 491 Wosize_val(ElementVals)); 492} 493 494/*--... Operations on scalar constants .....................................--*/ 495 496/* lltype -> int -> llvalue */ 497CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) { 498 return LLVMConstInt(IntTy, (long long) Int_val(N), 1); 499} 500 501/* lltype -> Int64.t -> bool -> llvalue */ 502CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N, 503 value SExt) { 504 return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt)); 505} 506 507/* lltype -> string -> int -> llvalue */ 508CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S, 509 value Radix) { 510 return LLVMConstIntOfStringAndSize(IntTy, String_val(S), caml_string_length(S), 511 Int_val(Radix)); 512} 513 514/* lltype -> float -> llvalue */ 515CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) { 516 return LLVMConstReal(RealTy, Double_val(N)); 517} 518 519/* lltype -> string -> llvalue */ 520CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) { 521 return LLVMConstRealOfStringAndSize(RealTy, String_val(S), 522 caml_string_length(S)); 523} 524 525/*--... Operations on composite constants ..................................--*/ 526 527/* llcontext -> string -> llvalue */ 528CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str, 529 value NullTerminate) { 530 return LLVMConstStringInContext(Context, String_val(Str), string_length(Str), 531 1); 532} 533 534/* llcontext -> string -> llvalue */ 535CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str, 536 value NullTerminate) { 537 return LLVMConstStringInContext(Context, String_val(Str), string_length(Str), 538 0); 539} 540 541/* lltype -> llvalue array -> llvalue */ 542CAMLprim LLVMValueRef llvm_const_array(LLVMTypeRef ElementTy, 543 value ElementVals) { 544 return LLVMConstArray(ElementTy, (LLVMValueRef*) Op_val(ElementVals), 545 Wosize_val(ElementVals)); 546} 547 548/* llcontext -> llvalue array -> llvalue */ 549CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) { 550 return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals), 551 Wosize_val(ElementVals), 0); 552} 553 554/* llcontext -> llvalue array -> llvalue */ 555CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C, 556 value ElementVals) { 557 return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals), 558 Wosize_val(ElementVals), 1); 559} 560 561/* llvalue array -> llvalue */ 562CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) { 563 return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals), 564 Wosize_val(ElementVals)); 565} 566 567/*--... Constant expressions ...............................................--*/ 568 569/* Icmp.t -> llvalue -> llvalue -> llvalue */ 570CAMLprim LLVMValueRef llvm_const_icmp(value Pred, 571 LLVMValueRef LHSConstant, 572 LLVMValueRef RHSConstant) { 573 return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant); 574} 575 576/* Fcmp.t -> llvalue -> llvalue -> llvalue */ 577CAMLprim LLVMValueRef llvm_const_fcmp(value Pred, 578 LLVMValueRef LHSConstant, 579 LLVMValueRef RHSConstant) { 580 return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant); 581} 582 583/* llvalue -> llvalue array -> llvalue */ 584CAMLprim LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) { 585 return LLVMConstGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices), 586 Wosize_val(Indices)); 587} 588 589/* llvalue -> llvalue array -> llvalue */ 590CAMLprim LLVMValueRef llvm_const_in_bounds_gep(LLVMValueRef ConstantVal, 591 value Indices) { 592 return LLVMConstInBoundsGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices), 593 Wosize_val(Indices)); 594} 595 596/* llvalue -> int array -> llvalue */ 597CAMLprim LLVMValueRef llvm_const_extractvalue(LLVMValueRef Aggregate, 598 value Indices) { 599 CAMLparam1(Indices); 600 int size = Wosize_val(Indices); 601 int i; 602 LLVMValueRef result; 603 604 unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned)); 605 for (i = 0; i < size; i++) { 606 idxs[i] = Int_val(Field(Indices, i)); 607 } 608 609 result = LLVMConstExtractValue(Aggregate, idxs, size); 610 free(idxs); 611 CAMLreturnT(LLVMValueRef, result); 612} 613 614/* llvalue -> llvalue -> int array -> llvalue */ 615CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate, 616 LLVMValueRef Val, value Indices) { 617 CAMLparam1(Indices); 618 int size = Wosize_val(Indices); 619 int i; 620 LLVMValueRef result; 621 622 unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned)); 623 for (i = 0; i < size; i++) { 624 idxs[i] = Int_val(Field(Indices, i)); 625 } 626 627 result = LLVMConstInsertValue(Aggregate, Val, idxs, size); 628 free(idxs); 629 CAMLreturnT(LLVMValueRef, result); 630} 631 632/*--... Operations on global variables, functions, and aliases (globals) ...--*/ 633 634/* llvalue -> bool */ 635CAMLprim value llvm_is_declaration(LLVMValueRef Global) { 636 return Val_bool(LLVMIsDeclaration(Global)); 637} 638 639/* llvalue -> Linkage.t */ 640CAMLprim value llvm_linkage(LLVMValueRef Global) { 641 return Val_int(LLVMGetLinkage(Global)); 642} 643 644/* Linkage.t -> llvalue -> unit */ 645CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) { 646 LLVMSetLinkage(Global, Int_val(Linkage)); 647 return Val_unit; 648} 649 650/* llvalue -> string */ 651CAMLprim value llvm_section(LLVMValueRef Global) { 652 return copy_string(LLVMGetSection(Global)); 653} 654 655/* string -> llvalue -> unit */ 656CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) { 657 LLVMSetSection(Global, String_val(Section)); 658 return Val_unit; 659} 660 661/* llvalue -> Visibility.t */ 662CAMLprim value llvm_visibility(LLVMValueRef Global) { 663 return Val_int(LLVMGetVisibility(Global)); 664} 665 666/* Visibility.t -> llvalue -> unit */ 667CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) { 668 LLVMSetVisibility(Global, Int_val(Viz)); 669 return Val_unit; 670} 671 672/* llvalue -> int */ 673CAMLprim value llvm_alignment(LLVMValueRef Global) { 674 return Val_int(LLVMGetAlignment(Global)); 675} 676 677/* int -> llvalue -> unit */ 678CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) { 679 LLVMSetAlignment(Global, Int_val(Bytes)); 680 return Val_unit; 681} 682 683/*--... Operations on global variables .....................................--*/ 684 685DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef, 686 LLVMGetGlobalParent) 687 688/* lltype -> string -> llmodule -> llvalue */ 689CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name, 690 LLVMModuleRef M) { 691 LLVMValueRef GlobalVar; 692 if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) { 693 if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty) 694 return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty, 0)); 695 return GlobalVar; 696 } 697 return LLVMAddGlobal(M, Ty, String_val(Name)); 698} 699 700/* string -> llmodule -> llvalue option */ 701CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) { 702 CAMLparam1(Name); 703 LLVMValueRef GlobalVar; 704 if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) { 705 value Option = alloc(1, 0); 706 Field(Option, 0) = (value) GlobalVar; 707 CAMLreturn(Option); 708 } 709 CAMLreturn(Val_int(0)); 710} 711 712/* string -> llvalue -> llmodule -> llvalue */ 713CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer, 714 LLVMModuleRef M) { 715 LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer), 716 String_val(Name)); 717 LLVMSetInitializer(GlobalVar, Initializer); 718 return GlobalVar; 719} 720 721/* llvalue -> unit */ 722CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) { 723 LLVMDeleteGlobal(GlobalVar); 724 return Val_unit; 725} 726 727/* llvalue -> llvalue -> unit */ 728CAMLprim value llvm_set_initializer(LLVMValueRef ConstantVal, 729 LLVMValueRef GlobalVar) { 730 LLVMSetInitializer(GlobalVar, ConstantVal); 731 return Val_unit; 732} 733 734/* llvalue -> unit */ 735CAMLprim value llvm_remove_initializer(LLVMValueRef GlobalVar) { 736 LLVMSetInitializer(GlobalVar, NULL); 737 return Val_unit; 738} 739 740/* llvalue -> bool */ 741CAMLprim value llvm_is_thread_local(LLVMValueRef GlobalVar) { 742 return Val_bool(LLVMIsThreadLocal(GlobalVar)); 743} 744 745/* bool -> llvalue -> unit */ 746CAMLprim value llvm_set_thread_local(value IsThreadLocal, 747 LLVMValueRef GlobalVar) { 748 LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal)); 749 return Val_unit; 750} 751 752/* llvalue -> bool */ 753CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) { 754 return Val_bool(LLVMIsGlobalConstant(GlobalVar)); 755} 756 757/* bool -> llvalue -> unit */ 758CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) { 759 LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag)); 760 return Val_unit; 761} 762 763/*--... Operations on functions ............................................--*/ 764 765DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef, 766 LLVMGetGlobalParent) 767 768/* string -> lltype -> llmodule -> llvalue */ 769CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty, 770 LLVMModuleRef M) { 771 LLVMValueRef Fn; 772 if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) { 773 if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty) 774 return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0)); 775 return Fn; 776 } 777 return LLVMAddFunction(M, String_val(Name), Ty); 778} 779 780/* string -> llmodule -> llvalue option */ 781CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) { 782 CAMLparam1(Name); 783 LLVMValueRef Fn; 784 if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) { 785 value Option = alloc(1, 0); 786 Field(Option, 0) = (value) Fn; 787 CAMLreturn(Option); 788 } 789 CAMLreturn(Val_int(0)); 790} 791 792/* string -> lltype -> llmodule -> llvalue */ 793CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty, 794 LLVMModuleRef M) { 795 LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty); 796 LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry"); 797 return Fn; 798} 799 800/* llvalue -> unit */ 801CAMLprim value llvm_delete_function(LLVMValueRef Fn) { 802 LLVMDeleteFunction(Fn); 803 return Val_unit; 804} 805 806/* llvalue -> bool */ 807CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) { 808 return Val_bool(LLVMGetIntrinsicID(Fn)); 809} 810 811/* llvalue -> int */ 812CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) { 813 return Val_int(LLVMGetFunctionCallConv(Fn)); 814} 815 816/* int -> llvalue -> unit */ 817CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) { 818 LLVMSetFunctionCallConv(Fn, Int_val(Id)); 819 return Val_unit; 820} 821 822/* llvalue -> string option */ 823CAMLprim value llvm_gc(LLVMValueRef Fn) { 824 const char *GC; 825 CAMLparam0(); 826 CAMLlocal2(Name, Option); 827 828 if ((GC = LLVMGetGC(Fn))) { 829 Name = copy_string(GC); 830 831 Option = alloc(1, 0); 832 Field(Option, 0) = Name; 833 CAMLreturn(Option); 834 } else { 835 CAMLreturn(Val_int(0)); 836 } 837} 838 839/* string option -> llvalue -> unit */ 840CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) { 841 LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0))); 842 return Val_unit; 843} 844 845/* llvalue -> Attribute.t -> unit */ 846CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) { 847 LLVMAddFunctionAttr(Arg, 1<<Int_val(PA)); 848 return Val_unit; 849} 850 851/* llvalue -> Attribute.t -> unit */ 852CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) { 853 LLVMRemoveFunctionAttr(Arg, 1<<Int_val(PA)); 854 return Val_unit; 855} 856/*--... Operations on parameters ...........................................--*/ 857 858DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent) 859 860/* llvalue -> int -> llvalue */ 861CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) { 862 return LLVMGetParam(Fn, Int_val(Index)); 863} 864 865/* llvalue -> int -> llvalue */ 866CAMLprim value llvm_params(LLVMValueRef Fn, value Index) { 867 value Params = alloc(LLVMCountParams(Fn), 0); 868 LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params)); 869 return Params; 870} 871 872/* llvalue -> Attribute.t -> unit */ 873CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) { 874 LLVMAddAttribute(Arg, 1<<Int_val(PA)); 875 return Val_unit; 876} 877 878/* llvalue -> Attribute.t -> unit */ 879CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) { 880 LLVMRemoveAttribute(Arg, 1<<Int_val(PA)); 881 return Val_unit; 882} 883 884/* llvalue -> int -> unit */ 885CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) { 886 LLVMSetParamAlignment(Arg, Int_val(align)); 887 return Val_unit; 888} 889 890/*--... Operations on basic blocks .........................................--*/ 891 892DEFINE_ITERATORS( 893 block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent) 894 895/* llvalue -> llbasicblock array */ 896CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) { 897 value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0); 898 LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray)); 899 return MLArray; 900} 901 902/* llbasicblock -> unit */ 903CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) { 904 LLVMDeleteBasicBlock(BB); 905 return Val_unit; 906} 907 908/* string -> llvalue -> llbasicblock */ 909CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name, 910 LLVMValueRef Fn) { 911 return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name)); 912} 913 914/* string -> llbasicblock -> llbasicblock */ 915CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name, 916 LLVMBasicBlockRef BB) { 917 return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name)); 918} 919 920/* llvalue -> bool */ 921CAMLprim value llvm_value_is_block(LLVMValueRef Val) { 922 return Val_bool(LLVMValueIsBasicBlock(Val)); 923} 924 925/*--... Operations on instructions .........................................--*/ 926 927DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef, 928 LLVMGetInstructionParent) 929 930 931/*--... Operations on call sites ...........................................--*/ 932 933/* llvalue -> int */ 934CAMLprim value llvm_instruction_call_conv(LLVMValueRef Inst) { 935 return Val_int(LLVMGetInstructionCallConv(Inst)); 936} 937 938/* int -> llvalue -> unit */ 939CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) { 940 LLVMSetInstructionCallConv(Inst, Int_val(CC)); 941 return Val_unit; 942} 943 944/* llvalue -> int -> Attribute.t -> unit */ 945CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr, 946 value index, 947 value PA) { 948 LLVMAddInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA)); 949 return Val_unit; 950} 951 952/* llvalue -> int -> Attribute.t -> unit */ 953CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr, 954 value index, 955 value PA) { 956 LLVMRemoveInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA)); 957 return Val_unit; 958} 959 960/*--... Operations on call instructions (only) .............................--*/ 961 962/* llvalue -> bool */ 963CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) { 964 return Val_bool(LLVMIsTailCall(CallInst)); 965} 966 967/* bool -> llvalue -> unit */ 968CAMLprim value llvm_set_tail_call(value IsTailCall, 969 LLVMValueRef CallInst) { 970 LLVMSetTailCall(CallInst, Bool_val(IsTailCall)); 971 return Val_unit; 972} 973 974/*--... Operations on phi nodes ............................................--*/ 975 976/* (llvalue * llbasicblock) -> llvalue -> unit */ 977CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) { 978 LLVMAddIncoming(PhiNode, 979 (LLVMValueRef*) &Field(Incoming, 0), 980 (LLVMBasicBlockRef*) &Field(Incoming, 1), 981 1); 982 return Val_unit; 983} 984 985/* llvalue -> (llvalue * llbasicblock) list */ 986CAMLprim value llvm_incoming(LLVMValueRef PhiNode) { 987 unsigned I; 988 CAMLparam0(); 989 CAMLlocal3(Hd, Tl, Tmp); 990 991 /* Build a tuple list of them. */ 992 Tl = Val_int(0); 993 for (I = LLVMCountIncoming(PhiNode); I != 0; ) { 994 Hd = alloc(2, 0); 995 Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I)); 996 Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I)); 997 998 Tmp = alloc(2, 0); 999 Store_field(Tmp, 0, Hd); 1000 Store_field(Tmp, 1, Tl); 1001 Tl = Tmp; 1002 } 1003 1004 CAMLreturn(Tl); 1005} 1006 1007 1008/*===-- Instruction builders ----------------------------------------------===*/ 1009 1010#define Builder_val(v) (*(LLVMBuilderRef *)(Data_custom_val(v))) 1011 1012static void llvm_finalize_builder(value B) { 1013 LLVMDisposeBuilder(Builder_val(B)); 1014} 1015 1016static struct custom_operations builder_ops = { 1017 (char *) "IRBuilder", 1018 llvm_finalize_builder, 1019 custom_compare_default, 1020 custom_hash_default, 1021 custom_serialize_default, 1022 custom_deserialize_default 1023}; 1024 1025static value alloc_builder(LLVMBuilderRef B) { 1026 value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1); 1027 Builder_val(V) = B; 1028 return V; 1029} 1030 1031/* llcontext -> llbuilder */ 1032CAMLprim value llvm_builder(LLVMContextRef C) { 1033 return alloc_builder(LLVMCreateBuilderInContext(C)); 1034} 1035 1036/* (llbasicblock, llvalue) llpos -> llbuilder -> unit */ 1037CAMLprim value llvm_position_builder(value Pos, value B) { 1038 if (Tag_val(Pos) == 0) { 1039 LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0)); 1040 LLVMPositionBuilderAtEnd(Builder_val(B), BB); 1041 } else { 1042 LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0)); 1043 LLVMPositionBuilderBefore(Builder_val(B), I); 1044 } 1045 return Val_unit; 1046} 1047 1048/* llbuilder -> llbasicblock */ 1049CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) { 1050 LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B)); 1051 if (!InsertBlock) 1052 raise_not_found(); 1053 return InsertBlock; 1054} 1055 1056/* llvalue -> string -> llbuilder -> unit */ 1057CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) { 1058 LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name)); 1059 return Val_unit; 1060} 1061 1062/*--... Metadata ...........................................................--*/ 1063 1064/* llbuilder -> llvalue -> unit */ 1065CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) { 1066 LLVMSetCurrentDebugLocation(Builder_val(B), V); 1067 return Val_unit; 1068} 1069 1070/* llbuilder -> unit */ 1071CAMLprim value llvm_clear_current_debug_location(value B) { 1072 LLVMSetCurrentDebugLocation(Builder_val(B), NULL); 1073 return Val_unit; 1074} 1075 1076/* llbuilder -> llvalue option */ 1077CAMLprim value llvm_current_debug_location(value B) { 1078 CAMLparam0(); 1079 LLVMValueRef L; 1080 if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) { 1081 value Option = alloc(1, 0); 1082 Field(Option, 0) = (value) L; 1083 CAMLreturn(Option); 1084 } 1085 CAMLreturn(Val_int(0)); 1086} 1087 1088/* llbuilder -> llvalue -> unit */ 1089CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) { 1090 LLVMSetInstDebugLocation(Builder_val(B), V); 1091 return Val_unit; 1092} 1093 1094 1095/*--... Terminators ........................................................--*/ 1096 1097/* llbuilder -> llvalue */ 1098CAMLprim LLVMValueRef llvm_build_ret_void(value B) { 1099 return LLVMBuildRetVoid(Builder_val(B)); 1100} 1101 1102/* llvalue -> llbuilder -> llvalue */ 1103CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) { 1104 return LLVMBuildRet(Builder_val(B), Val); 1105} 1106 1107/* llvalue array -> llbuilder -> llvalue */ 1108CAMLprim LLVMValueRef llvm_build_aggregate_ret(value RetVals, value B) { 1109 return LLVMBuildAggregateRet(Builder_val(B), (LLVMValueRef *) Op_val(RetVals), 1110 Wosize_val(RetVals)); 1111} 1112 1113/* llbasicblock -> llbuilder -> llvalue */ 1114CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) { 1115 return LLVMBuildBr(Builder_val(B), BB); 1116} 1117 1118/* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */ 1119CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If, 1120 LLVMBasicBlockRef Then, 1121 LLVMBasicBlockRef Else, 1122 value B) { 1123 return LLVMBuildCondBr(Builder_val(B), If, Then, Else); 1124} 1125 1126/* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */ 1127CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of, 1128 LLVMBasicBlockRef Else, 1129 value EstimatedCount, 1130 value B) { 1131 return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount)); 1132} 1133 1134/* llvalue -> llvalue -> llbasicblock -> unit */ 1135CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal, 1136 LLVMBasicBlockRef Dest) { 1137 LLVMAddCase(Switch, OnVal, Dest); 1138 return Val_unit; 1139} 1140 1141/* llvalue -> llbasicblock -> llbuilder -> llvalue */ 1142CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr, 1143 value EstimatedDests, 1144 value B) { 1145 return LLVMBuildIndirectBr(Builder_val(B), Addr, EstimatedDests); 1146} 1147 1148/* llvalue -> llvalue -> llbasicblock -> unit */ 1149CAMLprim value llvm_add_destination(LLVMValueRef IndirectBr, 1150 LLVMBasicBlockRef Dest) { 1151 LLVMAddDestination(IndirectBr, Dest); 1152 return Val_unit; 1153} 1154 1155/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string -> 1156 llbuilder -> llvalue */ 1157CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args, 1158 LLVMBasicBlockRef Then, 1159 LLVMBasicBlockRef Catch, 1160 value Name, value B) { 1161 return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Args), 1162 Wosize_val(Args), Then, Catch, String_val(Name)); 1163} 1164 1165/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string -> 1166 llbuilder -> llvalue */ 1167CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) { 1168 return llvm_build_invoke_nat((LLVMValueRef) Args[0], Args[1], 1169 (LLVMBasicBlockRef) Args[2], 1170 (LLVMBasicBlockRef) Args[3], 1171 Args[4], Args[5]); 1172} 1173 1174/* llbuilder -> llvalue */ 1175CAMLprim LLVMValueRef llvm_build_unwind(value B) { 1176 return LLVMBuildUnwind(Builder_val(B)); 1177} 1178 1179/* llbuilder -> llvalue */ 1180CAMLprim LLVMValueRef llvm_build_unreachable(value B) { 1181 return LLVMBuildUnreachable(Builder_val(B)); 1182} 1183 1184/*--... Arithmetic .........................................................--*/ 1185 1186/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1187CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS, 1188 value Name, value B) { 1189 return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name)); 1190} 1191 1192/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1193CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS, 1194 value Name, value B) { 1195 return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name)); 1196} 1197 1198/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1199CAMLprim LLVMValueRef llvm_build_nuw_add(LLVMValueRef LHS, LLVMValueRef RHS, 1200 value Name, value B) { 1201 return LLVMBuildNUWAdd(Builder_val(B), LHS, RHS, String_val(Name)); 1202} 1203 1204/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1205CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS, 1206 value Name, value B) { 1207 return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name)); 1208} 1209 1210/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1211CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS, 1212 value Name, value B) { 1213 return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name)); 1214} 1215 1216/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1217CAMLprim LLVMValueRef llvm_build_nsw_sub(LLVMValueRef LHS, LLVMValueRef RHS, 1218 value Name, value B) { 1219 return LLVMBuildNSWSub(Builder_val(B), LHS, RHS, String_val(Name)); 1220} 1221 1222/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1223CAMLprim LLVMValueRef llvm_build_nuw_sub(LLVMValueRef LHS, LLVMValueRef RHS, 1224 value Name, value B) { 1225 return LLVMBuildNUWSub(Builder_val(B), LHS, RHS, String_val(Name)); 1226} 1227 1228/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1229CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS, 1230 value Name, value B) { 1231 return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name)); 1232} 1233 1234/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1235CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS, 1236 value Name, value B) { 1237 return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name)); 1238} 1239 1240/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1241CAMLprim LLVMValueRef llvm_build_nsw_mul(LLVMValueRef LHS, LLVMValueRef RHS, 1242 value Name, value B) { 1243 return LLVMBuildNSWMul(Builder_val(B), LHS, RHS, String_val(Name)); 1244} 1245 1246/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1247CAMLprim LLVMValueRef llvm_build_nuw_mul(LLVMValueRef LHS, LLVMValueRef RHS, 1248 value Name, value B) { 1249 return LLVMBuildNUWMul(Builder_val(B), LHS, RHS, String_val(Name)); 1250} 1251 1252/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1253CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS, 1254 value Name, value B) { 1255 return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name)); 1256} 1257 1258/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1259CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS, 1260 value Name, value B) { 1261 return LLVMBuildUDiv(Builder_val(B), LHS, RHS, String_val(Name)); 1262} 1263 1264/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1265CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS, 1266 value Name, value B) { 1267 return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name)); 1268} 1269 1270/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1271CAMLprim LLVMValueRef llvm_build_exact_sdiv(LLVMValueRef LHS, LLVMValueRef RHS, 1272 value Name, value B) { 1273 return LLVMBuildExactSDiv(Builder_val(B), LHS, RHS, String_val(Name)); 1274} 1275 1276/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1277CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS, 1278 value Name, value B) { 1279 return LLVMBuildFDiv(Builder_val(B), LHS, RHS, String_val(Name)); 1280} 1281 1282/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1283CAMLprim LLVMValueRef llvm_build_urem(LLVMValueRef LHS, LLVMValueRef RHS, 1284 value Name, value B) { 1285 return LLVMBuildURem(Builder_val(B), LHS, RHS, String_val(Name)); 1286} 1287 1288/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1289CAMLprim LLVMValueRef llvm_build_srem(LLVMValueRef LHS, LLVMValueRef RHS, 1290 value Name, value B) { 1291 return LLVMBuildSRem(Builder_val(B), LHS, RHS, String_val(Name)); 1292} 1293 1294/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1295CAMLprim LLVMValueRef llvm_build_frem(LLVMValueRef LHS, LLVMValueRef RHS, 1296 value Name, value B) { 1297 return LLVMBuildFRem(Builder_val(B), LHS, RHS, String_val(Name)); 1298} 1299 1300/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1301CAMLprim LLVMValueRef llvm_build_shl(LLVMValueRef LHS, LLVMValueRef RHS, 1302 value Name, value B) { 1303 return LLVMBuildShl(Builder_val(B), LHS, RHS, String_val(Name)); 1304} 1305 1306/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1307CAMLprim LLVMValueRef llvm_build_lshr(LLVMValueRef LHS, LLVMValueRef RHS, 1308 value Name, value B) { 1309 return LLVMBuildLShr(Builder_val(B), LHS, RHS, String_val(Name)); 1310} 1311 1312/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1313CAMLprim LLVMValueRef llvm_build_ashr(LLVMValueRef LHS, LLVMValueRef RHS, 1314 value Name, value B) { 1315 return LLVMBuildAShr(Builder_val(B), LHS, RHS, String_val(Name)); 1316} 1317 1318/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1319CAMLprim LLVMValueRef llvm_build_and(LLVMValueRef LHS, LLVMValueRef RHS, 1320 value Name, value B) { 1321 return LLVMBuildAnd(Builder_val(B), LHS, RHS, String_val(Name)); 1322} 1323 1324/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1325CAMLprim LLVMValueRef llvm_build_or(LLVMValueRef LHS, LLVMValueRef RHS, 1326 value Name, value B) { 1327 return LLVMBuildOr(Builder_val(B), LHS, RHS, String_val(Name)); 1328} 1329 1330/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1331CAMLprim LLVMValueRef llvm_build_xor(LLVMValueRef LHS, LLVMValueRef RHS, 1332 value Name, value B) { 1333 return LLVMBuildXor(Builder_val(B), LHS, RHS, String_val(Name)); 1334} 1335 1336/* llvalue -> string -> llbuilder -> llvalue */ 1337CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X, 1338 value Name, value B) { 1339 return LLVMBuildNeg(Builder_val(B), X, String_val(Name)); 1340} 1341 1342/* llvalue -> string -> llbuilder -> llvalue */ 1343CAMLprim LLVMValueRef llvm_build_nsw_neg(LLVMValueRef X, 1344 value Name, value B) { 1345 return LLVMBuildNSWNeg(Builder_val(B), X, String_val(Name)); 1346} 1347 1348/* llvalue -> string -> llbuilder -> llvalue */ 1349CAMLprim LLVMValueRef llvm_build_nuw_neg(LLVMValueRef X, 1350 value Name, value B) { 1351 return LLVMBuildNUWNeg(Builder_val(B), X, String_val(Name)); 1352} 1353 1354/* llvalue -> string -> llbuilder -> llvalue */ 1355CAMLprim LLVMValueRef llvm_build_fneg(LLVMValueRef X, 1356 value Name, value B) { 1357 return LLVMBuildFNeg(Builder_val(B), X, String_val(Name)); 1358} 1359 1360/* llvalue -> string -> llbuilder -> llvalue */ 1361CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X, 1362 value Name, value B) { 1363 return LLVMBuildNot(Builder_val(B), X, String_val(Name)); 1364} 1365 1366/*--... Memory .............................................................--*/ 1367 1368/* lltype -> string -> llbuilder -> llvalue */ 1369CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty, 1370 value Name, value B) { 1371 return LLVMBuildAlloca(Builder_val(B), Ty, String_val(Name)); 1372} 1373 1374/* lltype -> llvalue -> string -> llbuilder -> llvalue */ 1375CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size, 1376 value Name, value B) { 1377 return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name)); 1378} 1379 1380/* llvalue -> string -> llbuilder -> llvalue */ 1381CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer, 1382 value Name, value B) { 1383 return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name)); 1384} 1385 1386/* llvalue -> llvalue -> llbuilder -> llvalue */ 1387CAMLprim LLVMValueRef llvm_build_store(LLVMValueRef Value, LLVMValueRef Pointer, 1388 value B) { 1389 return LLVMBuildStore(Builder_val(B), Value, Pointer); 1390} 1391 1392/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */ 1393CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices, 1394 value Name, value B) { 1395 return LLVMBuildGEP(Builder_val(B), Pointer, 1396 (LLVMValueRef *) Op_val(Indices), Wosize_val(Indices), 1397 String_val(Name)); 1398} 1399 1400/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */ 1401CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer, 1402 value Indices, value Name, 1403 value B) { 1404 return LLVMBuildInBoundsGEP(Builder_val(B), Pointer, 1405 (LLVMValueRef *) Op_val(Indices), 1406 Wosize_val(Indices), String_val(Name)); 1407} 1408 1409/* llvalue -> int -> string -> llbuilder -> llvalue */ 1410CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer, 1411 value Index, value Name, 1412 value B) { 1413 return LLVMBuildStructGEP(Builder_val(B), Pointer, 1414 Int_val(Index), String_val(Name)); 1415} 1416 1417/* string -> string -> llbuilder -> llvalue */ 1418CAMLprim LLVMValueRef llvm_build_global_string(value Str, value Name, value B) { 1419 return LLVMBuildGlobalString(Builder_val(B), String_val(Str), 1420 String_val(Name)); 1421} 1422 1423/* string -> string -> llbuilder -> llvalue */ 1424CAMLprim LLVMValueRef llvm_build_global_stringptr(value Str, value Name, 1425 value B) { 1426 return LLVMBuildGlobalStringPtr(Builder_val(B), String_val(Str), 1427 String_val(Name)); 1428} 1429 1430/*--... Casts ..............................................................--*/ 1431 1432/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1433CAMLprim LLVMValueRef llvm_build_trunc(LLVMValueRef X, LLVMTypeRef Ty, 1434 value Name, value B) { 1435 return LLVMBuildTrunc(Builder_val(B), X, Ty, String_val(Name)); 1436} 1437 1438/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1439CAMLprim LLVMValueRef llvm_build_zext(LLVMValueRef X, LLVMTypeRef Ty, 1440 value Name, value B) { 1441 return LLVMBuildZExt(Builder_val(B), X, Ty, String_val(Name)); 1442} 1443 1444/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1445CAMLprim LLVMValueRef llvm_build_sext(LLVMValueRef X, LLVMTypeRef Ty, 1446 value Name, value B) { 1447 return LLVMBuildSExt(Builder_val(B), X, Ty, String_val(Name)); 1448} 1449 1450/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1451CAMLprim LLVMValueRef llvm_build_fptoui(LLVMValueRef X, LLVMTypeRef Ty, 1452 value Name, value B) { 1453 return LLVMBuildFPToUI(Builder_val(B), X, Ty, String_val(Name)); 1454} 1455 1456/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1457CAMLprim LLVMValueRef llvm_build_fptosi(LLVMValueRef X, LLVMTypeRef Ty, 1458 value Name, value B) { 1459 return LLVMBuildFPToSI(Builder_val(B), X, Ty, String_val(Name)); 1460} 1461 1462/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1463CAMLprim LLVMValueRef llvm_build_uitofp(LLVMValueRef X, LLVMTypeRef Ty, 1464 value Name, value B) { 1465 return LLVMBuildUIToFP(Builder_val(B), X, Ty, String_val(Name)); 1466} 1467 1468/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1469CAMLprim LLVMValueRef llvm_build_sitofp(LLVMValueRef X, LLVMTypeRef Ty, 1470 value Name, value B) { 1471 return LLVMBuildSIToFP(Builder_val(B), X, Ty, String_val(Name)); 1472} 1473 1474/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1475CAMLprim LLVMValueRef llvm_build_fptrunc(LLVMValueRef X, LLVMTypeRef Ty, 1476 value Name, value B) { 1477 return LLVMBuildFPTrunc(Builder_val(B), X, Ty, String_val(Name)); 1478} 1479 1480/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1481CAMLprim LLVMValueRef llvm_build_fpext(LLVMValueRef X, LLVMTypeRef Ty, 1482 value Name, value B) { 1483 return LLVMBuildFPExt(Builder_val(B), X, Ty, String_val(Name)); 1484} 1485 1486/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1487CAMLprim LLVMValueRef llvm_build_prttoint(LLVMValueRef X, LLVMTypeRef Ty, 1488 value Name, value B) { 1489 return LLVMBuildPtrToInt(Builder_val(B), X, Ty, String_val(Name)); 1490} 1491 1492/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1493CAMLprim LLVMValueRef llvm_build_inttoptr(LLVMValueRef X, LLVMTypeRef Ty, 1494 value Name, value B) { 1495 return LLVMBuildIntToPtr(Builder_val(B), X, Ty, String_val(Name)); 1496} 1497 1498/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1499CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty, 1500 value Name, value B) { 1501 return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name)); 1502} 1503 1504/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1505CAMLprim LLVMValueRef llvm_build_zext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty, 1506 value Name, value B) { 1507 return LLVMBuildZExtOrBitCast(Builder_val(B), X, Ty, String_val(Name)); 1508} 1509 1510/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1511CAMLprim LLVMValueRef llvm_build_sext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty, 1512 value Name, value B) { 1513 return LLVMBuildSExtOrBitCast(Builder_val(B), X, Ty, String_val(Name)); 1514} 1515 1516/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1517CAMLprim LLVMValueRef llvm_build_trunc_or_bitcast(LLVMValueRef X, 1518 LLVMTypeRef Ty, value Name, 1519 value B) { 1520 return LLVMBuildTruncOrBitCast(Builder_val(B), X, Ty, String_val(Name)); 1521} 1522 1523/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1524CAMLprim LLVMValueRef llvm_build_pointercast(LLVMValueRef X, LLVMTypeRef Ty, 1525 value Name, value B) { 1526 return LLVMBuildPointerCast(Builder_val(B), X, Ty, String_val(Name)); 1527} 1528 1529/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1530CAMLprim LLVMValueRef llvm_build_intcast(LLVMValueRef X, LLVMTypeRef Ty, 1531 value Name, value B) { 1532 return LLVMBuildIntCast(Builder_val(B), X, Ty, String_val(Name)); 1533} 1534 1535/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1536CAMLprim LLVMValueRef llvm_build_fpcast(LLVMValueRef X, LLVMTypeRef Ty, 1537 value Name, value B) { 1538 return LLVMBuildFPCast(Builder_val(B), X, Ty, String_val(Name)); 1539} 1540 1541/*--... Comparisons ........................................................--*/ 1542 1543/* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1544CAMLprim LLVMValueRef llvm_build_icmp(value Pred, 1545 LLVMValueRef LHS, LLVMValueRef RHS, 1546 value Name, value B) { 1547 return LLVMBuildICmp(Builder_val(B), Int_val(Pred) + LLVMIntEQ, LHS, RHS, 1548 String_val(Name)); 1549} 1550 1551/* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1552CAMLprim LLVMValueRef llvm_build_fcmp(value Pred, 1553 LLVMValueRef LHS, LLVMValueRef RHS, 1554 value Name, value B) { 1555 return LLVMBuildFCmp(Builder_val(B), Int_val(Pred), LHS, RHS, 1556 String_val(Name)); 1557} 1558 1559/*--... Miscellaneous instructions .........................................--*/ 1560 1561/* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */ 1562CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) { 1563 value Hd, Tl; 1564 LLVMValueRef FirstValue, PhiNode; 1565 1566 assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!"); 1567 1568 Hd = Field(Incoming, 0); 1569 FirstValue = (LLVMValueRef) Field(Hd, 0); 1570 PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue), 1571 String_val(Name)); 1572 1573 for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) { 1574 value Hd = Field(Tl, 0); 1575 LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0), 1576 (LLVMBasicBlockRef*) &Field(Hd, 1), 1); 1577 } 1578 1579 return PhiNode; 1580} 1581 1582/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */ 1583CAMLprim LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params, 1584 value Name, value B) { 1585 return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Params), 1586 Wosize_val(Params), String_val(Name)); 1587} 1588 1589/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1590CAMLprim LLVMValueRef llvm_build_select(LLVMValueRef If, 1591 LLVMValueRef Then, LLVMValueRef Else, 1592 value Name, value B) { 1593 return LLVMBuildSelect(Builder_val(B), If, Then, Else, String_val(Name)); 1594} 1595 1596/* llvalue -> lltype -> string -> llbuilder -> llvalue */ 1597CAMLprim LLVMValueRef llvm_build_va_arg(LLVMValueRef List, LLVMTypeRef Ty, 1598 value Name, value B) { 1599 return LLVMBuildVAArg(Builder_val(B), List, Ty, String_val(Name)); 1600} 1601 1602/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1603CAMLprim LLVMValueRef llvm_build_extractelement(LLVMValueRef Vec, 1604 LLVMValueRef Idx, 1605 value Name, value B) { 1606 return LLVMBuildExtractElement(Builder_val(B), Vec, Idx, String_val(Name)); 1607} 1608 1609/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1610CAMLprim LLVMValueRef llvm_build_insertelement(LLVMValueRef Vec, 1611 LLVMValueRef Element, 1612 LLVMValueRef Idx, 1613 value Name, value B) { 1614 return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx, 1615 String_val(Name)); 1616} 1617 1618/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1619CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2, 1620 LLVMValueRef Mask, 1621 value Name, value B) { 1622 return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name)); 1623} 1624 1625/* llvalue -> int -> string -> llbuilder -> llvalue */ 1626CAMLprim LLVMValueRef llvm_build_extractvalue(LLVMValueRef Aggregate, 1627 value Idx, value Name, value B) { 1628 return LLVMBuildExtractValue(Builder_val(B), Aggregate, Int_val(Idx), 1629 String_val(Name)); 1630} 1631 1632/* llvalue -> llvalue -> int -> string -> llbuilder -> llvalue */ 1633CAMLprim LLVMValueRef llvm_build_insertvalue(LLVMValueRef Aggregate, 1634 LLVMValueRef Val, value Idx, 1635 value Name, value B) { 1636 return LLVMBuildInsertValue(Builder_val(B), Aggregate, Val, Int_val(Idx), 1637 String_val(Name)); 1638} 1639 1640/* llvalue -> string -> llbuilder -> llvalue */ 1641CAMLprim LLVMValueRef llvm_build_is_null(LLVMValueRef Val, value Name, 1642 value B) { 1643 return LLVMBuildIsNull(Builder_val(B), Val, String_val(Name)); 1644} 1645 1646/* llvalue -> string -> llbuilder -> llvalue */ 1647CAMLprim LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name, 1648 value B) { 1649 return LLVMBuildIsNotNull(Builder_val(B), Val, String_val(Name)); 1650} 1651 1652/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ 1653CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS, 1654 value Name, value B) { 1655 return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name)); 1656} 1657 1658/*===-- Module Providers --------------------------------------------------===*/ 1659 1660/* llmoduleprovider -> unit */ 1661CAMLprim value llvm_dispose_module_provider(LLVMModuleProviderRef MP) { 1662 LLVMDisposeModuleProvider(MP); 1663 return Val_unit; 1664} 1665 1666 1667/*===-- Memory buffers ----------------------------------------------------===*/ 1668 1669/* string -> llmemorybuffer 1670 raises IoError msg on error */ 1671CAMLprim value llvm_memorybuffer_of_file(value Path) { 1672 CAMLparam1(Path); 1673 char *Message; 1674 LLVMMemoryBufferRef MemBuf; 1675 1676 if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path), 1677 &MemBuf, &Message)) 1678 llvm_raise(llvm_ioerror_exn, Message); 1679 1680 CAMLreturn((value) MemBuf); 1681} 1682 1683/* unit -> llmemorybuffer 1684 raises IoError msg on error */ 1685CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) { 1686 char *Message; 1687 LLVMMemoryBufferRef MemBuf; 1688 1689 if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message)) 1690 llvm_raise(llvm_ioerror_exn, Message); 1691 1692 return MemBuf; 1693} 1694 1695/* llmemorybuffer -> unit */ 1696CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) { 1697 LLVMDisposeMemoryBuffer(MemBuf); 1698 return Val_unit; 1699} 1700 1701/*===-- Pass Managers -----------------------------------------------------===*/ 1702 1703/* unit -> [ `Module ] PassManager.t */ 1704CAMLprim LLVMPassManagerRef llvm_passmanager_create(value Unit) { 1705 return LLVMCreatePassManager(); 1706} 1707 1708/* llmodule -> [ `Function ] PassManager.t -> bool */ 1709CAMLprim value llvm_passmanager_run_module(LLVMModuleRef M, 1710 LLVMPassManagerRef PM) { 1711 return Val_bool(LLVMRunPassManager(PM, M)); 1712} 1713 1714/* [ `Function ] PassManager.t -> bool */ 1715CAMLprim value llvm_passmanager_initialize(LLVMPassManagerRef FPM) { 1716 return Val_bool(LLVMInitializeFunctionPassManager(FPM)); 1717} 1718 1719/* llvalue -> [ `Function ] PassManager.t -> bool */ 1720CAMLprim value llvm_passmanager_run_function(LLVMValueRef F, 1721 LLVMPassManagerRef FPM) { 1722 return Val_bool(LLVMRunFunctionPassManager(FPM, F)); 1723} 1724 1725/* [ `Function ] PassManager.t -> bool */ 1726CAMLprim value llvm_passmanager_finalize(LLVMPassManagerRef FPM) { 1727 return Val_bool(LLVMFinalizeFunctionPassManager(FPM)); 1728} 1729 1730/* PassManager.any PassManager.t -> unit */ 1731CAMLprim value llvm_passmanager_dispose(LLVMPassManagerRef PM) { 1732 LLVMDisposePassManager(PM); 1733 return Val_unit; 1734} 1735