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