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