llvm.ml revision 4917ec9ec775d7bc7fbc3362b4c576c32b7617f4
1(*===-- llvm/llvm.ml - LLVM Ocaml Interface --------------------------------===* 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 11type llcontext 12type llmodule 13type lltype 14type llvalue 15type lluse 16type llbasicblock 17type llbuilder 18type llmemorybuffer 19 20module TypeKind = struct 21 type t = 22 | Void 23 | Float 24 | Double 25 | X86fp80 26 | Fp128 27 | Ppc_fp128 28 | Label 29 | Integer 30 | Function 31 | Struct 32 | Array 33 | Pointer 34 | Vector 35 | Metadata 36end 37 38module Linkage = struct 39 type t = 40 | External 41 | Available_externally 42 | Link_once 43 | Link_once_odr 44 | Weak 45 | Weak_odr 46 | Appending 47 | Internal 48 | Private 49 | Dllimport 50 | Dllexport 51 | External_weak 52 | Ghost 53 | Common 54 | Linker_private 55end 56 57module Visibility = struct 58 type t = 59 | Default 60 | Hidden 61 | Protected 62end 63 64module CallConv = struct 65 let c = 0 66 let fast = 8 67 let cold = 9 68 let x86_stdcall = 64 69 let x86_fastcall = 65 70end 71 72module Attribute = struct 73 type t = 74 | Zext 75 | Sext 76 | Noreturn 77 | Inreg 78 | Structret 79 | Nounwind 80 | Noalias 81 | Byval 82 | Nest 83 | Readnone 84 | Readonly 85 | Noinline 86 | Alwaysinline 87 | Optsize 88 | Ssp 89 | Sspreq 90 | Alignment of int 91 | Nocapture 92 | Noredzone 93 | Noimplicitfloat 94 | Naked 95 | Inlinehint 96 | Stackalignment of int 97end 98 99module Icmp = struct 100 type t = 101 | Eq 102 | Ne 103 | Ugt 104 | Uge 105 | Ult 106 | Ule 107 | Sgt 108 | Sge 109 | Slt 110 | Sle 111end 112 113module Fcmp = struct 114 type t = 115 | False 116 | Oeq 117 | Ogt 118 | Oge 119 | Olt 120 | Ole 121 | One 122 | Ord 123 | Uno 124 | Ueq 125 | Ugt 126 | Uge 127 | Ult 128 | Ule 129 | Une 130 | True 131end 132 133exception IoError of string 134 135external register_exns : exn -> unit = "llvm_register_core_exns" 136let _ = register_exns (IoError "") 137 138type ('a, 'b) llpos = 139| At_end of 'a 140| Before of 'b 141 142type ('a, 'b) llrev_pos = 143| At_start of 'a 144| After of 'b 145 146(*===-- Contexts ----------------------------------------------------------===*) 147external create_context : unit -> llcontext = "llvm_create_context" 148external dispose_context : llcontext -> unit = "llvm_dispose_context" 149external global_context : unit -> llcontext = "llvm_global_context" 150external mdkind_id : llcontext -> string -> int = "llvm_mdkind_id" 151 152(*===-- Modules -----------------------------------------------------------===*) 153external create_module : llcontext -> string -> llmodule = "llvm_create_module" 154external dispose_module : llmodule -> unit = "llvm_dispose_module" 155external target_triple: llmodule -> string 156 = "llvm_target_triple" 157external set_target_triple: string -> llmodule -> unit 158 = "llvm_set_target_triple" 159external data_layout: llmodule -> string 160 = "llvm_data_layout" 161external set_data_layout: string -> llmodule -> unit 162 = "llvm_set_data_layout" 163external dump_module : llmodule -> unit = "llvm_dump_module" 164external set_module_inline_asm : llmodule -> string -> unit 165 = "llvm_set_module_inline_asm" 166 167(*===-- Types -------------------------------------------------------------===*) 168external classify_type : lltype -> TypeKind.t = "llvm_classify_type" 169external type_context : lltype -> llcontext = "llvm_type_context" 170 171(*--... Operations on integer types ........................................--*) 172external i1_type : llcontext -> lltype = "llvm_i1_type" 173external i8_type : llcontext -> lltype = "llvm_i8_type" 174external i16_type : llcontext -> lltype = "llvm_i16_type" 175external i32_type : llcontext -> lltype = "llvm_i32_type" 176external i64_type : llcontext -> lltype = "llvm_i64_type" 177 178external integer_type : llcontext -> int -> lltype = "llvm_integer_type" 179external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth" 180 181(*--... Operations on real types ...........................................--*) 182external float_type : llcontext -> lltype = "llvm_float_type" 183external double_type : llcontext -> lltype = "llvm_double_type" 184external x86fp80_type : llcontext -> lltype = "llvm_x86fp80_type" 185external fp128_type : llcontext -> lltype = "llvm_fp128_type" 186external ppc_fp128_type : llcontext -> lltype = "llvm_ppc_fp128_type" 187 188(*--... Operations on function types .......................................--*) 189external function_type : lltype -> lltype array -> lltype = "llvm_function_type" 190external var_arg_function_type : lltype -> lltype array -> lltype 191 = "llvm_var_arg_function_type" 192external is_var_arg : lltype -> bool = "llvm_is_var_arg" 193external return_type : lltype -> lltype = "LLVMGetReturnType" 194external param_types : lltype -> lltype array = "llvm_param_types" 195 196(*--... Operations on struct types .........................................--*) 197external struct_type : llcontext -> lltype array -> lltype = "llvm_struct_type" 198external packed_struct_type : llcontext -> lltype array -> lltype 199 = "llvm_packed_struct_type" 200external struct_name : lltype -> string option = "llvm_struct_name" 201external struct_element_types : lltype -> lltype array 202 = "llvm_struct_element_types" 203external is_packed : lltype -> bool = "llvm_is_packed" 204 205(*--... Operations on pointer, vector, and array types .....................--*) 206external array_type : lltype -> int -> lltype = "llvm_array_type" 207external pointer_type : lltype -> lltype = "llvm_pointer_type" 208external qualified_pointer_type : lltype -> int -> lltype 209 = "llvm_qualified_pointer_type" 210external vector_type : lltype -> int -> lltype = "llvm_vector_type" 211 212external element_type : lltype -> lltype = "LLVMGetElementType" 213external array_length : lltype -> int = "llvm_array_length" 214external address_space : lltype -> int = "llvm_address_space" 215external vector_size : lltype -> int = "llvm_vector_size" 216 217(*--... Operations on other types ..........................................--*) 218external void_type : llcontext -> lltype = "llvm_void_type" 219external label_type : llcontext -> lltype = "llvm_label_type" 220 221(*===-- Values ------------------------------------------------------------===*) 222external type_of : llvalue -> lltype = "llvm_type_of" 223external value_name : llvalue -> string = "llvm_value_name" 224external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" 225external dump_value : llvalue -> unit = "llvm_dump_value" 226external replace_all_uses_with : llvalue -> llvalue -> unit 227 = "LLVMReplaceAllUsesWith" 228 229(*--... Operations on uses .................................................--*) 230external use_begin : llvalue -> lluse option = "llvm_use_begin" 231external use_succ : lluse -> lluse option = "llvm_use_succ" 232external user : lluse -> llvalue = "llvm_user" 233external used_value : lluse -> llvalue = "llvm_used_value" 234 235let iter_uses f v = 236 let rec aux = function 237 | None -> () 238 | Some u -> 239 f u; 240 aux (use_succ u) 241 in 242 aux (use_begin v) 243 244let fold_left_uses f init v = 245 let rec aux init u = 246 match u with 247 | None -> init 248 | Some u -> aux (f init u) (use_succ u) 249 in 250 aux init (use_begin v) 251 252let fold_right_uses f v init = 253 let rec aux u init = 254 match u with 255 | None -> init 256 | Some u -> f u (aux (use_succ u) init) 257 in 258 aux (use_begin v) init 259 260 261(*--... Operations on users ................................................--*) 262external operand : llvalue -> int -> llvalue = "llvm_operand" 263external set_operand : llvalue -> int -> llvalue -> unit = "llvm_set_operand" 264external num_operands : llvalue -> int = "llvm_num_operands" 265 266(*--... Operations on constants of (mostly) any type .......................--*) 267external is_constant : llvalue -> bool = "llvm_is_constant" 268external const_null : lltype -> llvalue = "LLVMConstNull" 269external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes" 270external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull" 271external undef : lltype -> llvalue = "LLVMGetUndef" 272external is_null : llvalue -> bool = "llvm_is_null" 273external is_undef : llvalue -> bool = "llvm_is_undef" 274 275(*--... Operations on instructions .........................................--*) 276external has_metadata : llvalue -> bool = "llvm_has_metadata" 277external metadata : llvalue -> int -> llvalue option = "llvm_metadata" 278external set_metadata : llvalue -> int -> llvalue -> unit = "llvm_set_metadata" 279external clear_metadata : llvalue -> int -> unit = "llvm_clear_metadata" 280 281(*--... Operations on metadata .......,.....................................--*) 282external mdstring : llcontext -> string -> llvalue = "llvm_mdstring" 283external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode" 284external get_mdstring : llvalue -> string option = "llvm_get_mdstring" 285external get_named_metadata : llmodule -> string -> llvalue array = "llvm_get_namedmd" 286 287(*--... Operations on scalar constants .....................................--*) 288external const_int : lltype -> int -> llvalue = "llvm_const_int" 289external const_of_int64 : lltype -> Int64.t -> bool -> llvalue 290 = "llvm_const_of_int64" 291external const_int_of_string : lltype -> string -> int -> llvalue 292 = "llvm_const_int_of_string" 293external const_float : lltype -> float -> llvalue = "llvm_const_float" 294external const_float_of_string : lltype -> string -> llvalue 295 = "llvm_const_float_of_string" 296 297(*--... Operations on composite constants ..................................--*) 298external const_string : llcontext -> string -> llvalue = "llvm_const_string" 299external const_stringz : llcontext -> string -> llvalue = "llvm_const_stringz" 300external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array" 301external const_struct : llcontext -> llvalue array -> llvalue 302 = "llvm_const_struct" 303external const_packed_struct : llcontext -> llvalue array -> llvalue 304 = "llvm_const_packed_struct" 305external const_vector : llvalue array -> llvalue = "llvm_const_vector" 306 307(*--... Constant expressions ...............................................--*) 308external align_of : lltype -> llvalue = "LLVMAlignOf" 309external size_of : lltype -> llvalue = "LLVMSizeOf" 310external const_neg : llvalue -> llvalue = "LLVMConstNeg" 311external const_nsw_neg : llvalue -> llvalue = "LLVMConstNSWNeg" 312external const_nuw_neg : llvalue -> llvalue = "LLVMConstNUWNeg" 313external const_fneg : llvalue -> llvalue = "LLVMConstFNeg" 314external const_not : llvalue -> llvalue = "LLVMConstNot" 315external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd" 316external const_nsw_add : llvalue -> llvalue -> llvalue = "LLVMConstNSWAdd" 317external const_nuw_add : llvalue -> llvalue -> llvalue = "LLVMConstNUWAdd" 318external const_fadd : llvalue -> llvalue -> llvalue = "LLVMConstFAdd" 319external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub" 320external const_nsw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNSWSub" 321external const_nuw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNUWSub" 322external const_fsub : llvalue -> llvalue -> llvalue = "LLVMConstFSub" 323external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul" 324external const_nsw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNSWMul" 325external const_nuw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNUWMul" 326external const_fmul : llvalue -> llvalue -> llvalue = "LLVMConstFMul" 327external const_udiv : llvalue -> llvalue -> llvalue = "LLVMConstUDiv" 328external const_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstSDiv" 329external const_exact_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstExactSDiv" 330external const_fdiv : llvalue -> llvalue -> llvalue = "LLVMConstFDiv" 331external const_urem : llvalue -> llvalue -> llvalue = "LLVMConstURem" 332external const_srem : llvalue -> llvalue -> llvalue = "LLVMConstSRem" 333external const_frem : llvalue -> llvalue -> llvalue = "LLVMConstFRem" 334external const_and : llvalue -> llvalue -> llvalue = "LLVMConstAnd" 335external const_or : llvalue -> llvalue -> llvalue = "LLVMConstOr" 336external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor" 337external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue 338 = "llvm_const_icmp" 339external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue 340 = "llvm_const_fcmp" 341external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl" 342external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr" 343external const_ashr : llvalue -> llvalue -> llvalue = "LLVMConstAShr" 344external const_gep : llvalue -> llvalue array -> llvalue = "llvm_const_gep" 345external const_in_bounds_gep : llvalue -> llvalue array -> llvalue 346 = "llvm_const_in_bounds_gep" 347external const_trunc : llvalue -> lltype -> llvalue = "LLVMConstTrunc" 348external const_sext : llvalue -> lltype -> llvalue = "LLVMConstSExt" 349external const_zext : llvalue -> lltype -> llvalue = "LLVMConstZExt" 350external const_fptrunc : llvalue -> lltype -> llvalue = "LLVMConstFPTrunc" 351external const_fpext : llvalue -> lltype -> llvalue = "LLVMConstFPExt" 352external const_uitofp : llvalue -> lltype -> llvalue = "LLVMConstUIToFP" 353external const_sitofp : llvalue -> lltype -> llvalue = "LLVMConstSIToFP" 354external const_fptoui : llvalue -> lltype -> llvalue = "LLVMConstFPToUI" 355external const_fptosi : llvalue -> lltype -> llvalue = "LLVMConstFPToSI" 356external const_ptrtoint : llvalue -> lltype -> llvalue = "LLVMConstPtrToInt" 357external const_inttoptr : llvalue -> lltype -> llvalue = "LLVMConstIntToPtr" 358external const_bitcast : llvalue -> lltype -> llvalue = "LLVMConstBitCast" 359external const_zext_or_bitcast : llvalue -> lltype -> llvalue 360 = "LLVMConstZExtOrBitCast" 361external const_sext_or_bitcast : llvalue -> lltype -> llvalue 362 = "LLVMConstSExtOrBitCast" 363external const_trunc_or_bitcast : llvalue -> lltype -> llvalue 364 = "LLVMConstTruncOrBitCast" 365external const_pointercast : llvalue -> lltype -> llvalue 366 = "LLVMConstPointerCast" 367external const_intcast : llvalue -> lltype -> llvalue = "LLVMConstIntCast" 368external const_fpcast : llvalue -> lltype -> llvalue = "LLVMConstFPCast" 369external const_select : llvalue -> llvalue -> llvalue -> llvalue 370 = "LLVMConstSelect" 371external const_extractelement : llvalue -> llvalue -> llvalue 372 = "LLVMConstExtractElement" 373external const_insertelement : llvalue -> llvalue -> llvalue -> llvalue 374 = "LLVMConstInsertElement" 375external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue 376 = "LLVMConstShuffleVector" 377external const_extractvalue : llvalue -> int array -> llvalue 378 = "llvm_const_extractvalue" 379external const_insertvalue : llvalue -> llvalue -> int array -> llvalue 380 = "llvm_const_insertvalue" 381external const_inline_asm : lltype -> string -> string -> bool -> bool -> 382 llvalue 383 = "llvm_const_inline_asm" 384external block_address : llvalue -> llbasicblock -> llvalue = "LLVMBlockAddress" 385 386(*--... Operations on global variables, functions, and aliases (globals) ...--*) 387external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent" 388external is_declaration : llvalue -> bool = "llvm_is_declaration" 389external linkage : llvalue -> Linkage.t = "llvm_linkage" 390external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" 391external section : llvalue -> string = "llvm_section" 392external set_section : string -> llvalue -> unit = "llvm_set_section" 393external visibility : llvalue -> Visibility.t = "llvm_visibility" 394external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility" 395external alignment : llvalue -> int = "llvm_alignment" 396external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" 397external is_global_constant : llvalue -> bool = "llvm_is_global_constant" 398external set_global_constant : bool -> llvalue -> unit 399 = "llvm_set_global_constant" 400 401(*--... Operations on global variables .....................................--*) 402external declare_global : lltype -> string -> llmodule -> llvalue 403 = "llvm_declare_global" 404external declare_qualified_global : lltype -> string -> int -> llmodule -> 405 llvalue 406 = "llvm_declare_qualified_global" 407external define_global : string -> llvalue -> llmodule -> llvalue 408 = "llvm_define_global" 409external define_qualified_global : string -> llvalue -> int -> llmodule -> 410 llvalue 411 = "llvm_define_qualified_global" 412external lookup_global : string -> llmodule -> llvalue option 413 = "llvm_lookup_global" 414external delete_global : llvalue -> unit = "llvm_delete_global" 415external global_initializer : llvalue -> llvalue = "LLVMGetInitializer" 416external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer" 417external remove_initializer : llvalue -> unit = "llvm_remove_initializer" 418external is_thread_local : llvalue -> bool = "llvm_is_thread_local" 419external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" 420external global_begin : llmodule -> (llmodule, llvalue) llpos 421 = "llvm_global_begin" 422external global_succ : llvalue -> (llmodule, llvalue) llpos 423 = "llvm_global_succ" 424external global_end : llmodule -> (llmodule, llvalue) llrev_pos 425 = "llvm_global_end" 426external global_pred : llvalue -> (llmodule, llvalue) llrev_pos 427 = "llvm_global_pred" 428 429let rec iter_global_range f i e = 430 if i = e then () else 431 match i with 432 | At_end _ -> raise (Invalid_argument "Invalid global variable range.") 433 | Before bb -> 434 f bb; 435 iter_global_range f (global_succ bb) e 436 437let iter_globals f m = 438 iter_global_range f (global_begin m) (At_end m) 439 440let rec fold_left_global_range f init i e = 441 if i = e then init else 442 match i with 443 | At_end _ -> raise (Invalid_argument "Invalid global variable range.") 444 | Before bb -> fold_left_global_range f (f init bb) (global_succ bb) e 445 446let fold_left_globals f init m = 447 fold_left_global_range f init (global_begin m) (At_end m) 448 449let rec rev_iter_global_range f i e = 450 if i = e then () else 451 match i with 452 | At_start _ -> raise (Invalid_argument "Invalid global variable range.") 453 | After bb -> 454 f bb; 455 rev_iter_global_range f (global_pred bb) e 456 457let rev_iter_globals f m = 458 rev_iter_global_range f (global_end m) (At_start m) 459 460let rec fold_right_global_range f i e init = 461 if i = e then init else 462 match i with 463 | At_start _ -> raise (Invalid_argument "Invalid global variable range.") 464 | After bb -> fold_right_global_range f (global_pred bb) e (f bb init) 465 466let fold_right_globals f m init = 467 fold_right_global_range f (global_end m) (At_start m) init 468 469(*--... Operations on aliases ..............................................--*) 470external add_alias : llmodule -> lltype -> llvalue -> string -> llvalue 471 = "llvm_add_alias" 472 473(*--... Operations on functions ............................................--*) 474external declare_function : string -> lltype -> llmodule -> llvalue 475 = "llvm_declare_function" 476external define_function : string -> lltype -> llmodule -> llvalue 477 = "llvm_define_function" 478external lookup_function : string -> llmodule -> llvalue option 479 = "llvm_lookup_function" 480external delete_function : llvalue -> unit = "llvm_delete_function" 481external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" 482external function_call_conv : llvalue -> int = "llvm_function_call_conv" 483external set_function_call_conv : int -> llvalue -> unit 484 = "llvm_set_function_call_conv" 485external gc : llvalue -> string option = "llvm_gc" 486external set_gc : string option -> llvalue -> unit = "llvm_set_gc" 487external function_begin : llmodule -> (llmodule, llvalue) llpos 488 = "llvm_function_begin" 489external function_succ : llvalue -> (llmodule, llvalue) llpos 490 = "llvm_function_succ" 491external function_end : llmodule -> (llmodule, llvalue) llrev_pos 492 = "llvm_function_end" 493external function_pred : llvalue -> (llmodule, llvalue) llrev_pos 494 = "llvm_function_pred" 495 496let rec iter_function_range f i e = 497 if i = e then () else 498 match i with 499 | At_end _ -> raise (Invalid_argument "Invalid function range.") 500 | Before fn -> 501 f fn; 502 iter_function_range f (function_succ fn) e 503 504let iter_functions f m = 505 iter_function_range f (function_begin m) (At_end m) 506 507let rec fold_left_function_range f init i e = 508 if i = e then init else 509 match i with 510 | At_end _ -> raise (Invalid_argument "Invalid function range.") 511 | Before fn -> fold_left_function_range f (f init fn) (function_succ fn) e 512 513let fold_left_functions f init m = 514 fold_left_function_range f init (function_begin m) (At_end m) 515 516let rec rev_iter_function_range f i e = 517 if i = e then () else 518 match i with 519 | At_start _ -> raise (Invalid_argument "Invalid function range.") 520 | After fn -> 521 f fn; 522 rev_iter_function_range f (function_pred fn) e 523 524let rev_iter_functions f m = 525 rev_iter_function_range f (function_end m) (At_start m) 526 527let rec fold_right_function_range f i e init = 528 if i = e then init else 529 match i with 530 | At_start _ -> raise (Invalid_argument "Invalid function range.") 531 | After fn -> fold_right_function_range f (function_pred fn) e (f fn init) 532 533let fold_right_functions f m init = 534 fold_right_function_range f (function_end m) (At_start m) init 535 536external llvm_add_function_attr : llvalue -> int -> unit 537 = "llvm_add_function_attr" 538external llvm_remove_function_attr : llvalue -> int -> unit 539 = "llvm_remove_function_attr" 540 541let pack_attr (attr:Attribute.t) : int = 542 match attr with 543 Attribute.Zext -> 1 lsl 0 544 | Attribute.Sext -> 1 lsl 1 545 | Attribute.Noreturn -> 1 lsl 2 546 | Attribute.Inreg -> 1 lsl 3 547 | Attribute.Structret -> 1 lsl 4 548 | Attribute.Nounwind -> 1 lsl 5 549 | Attribute.Noalias -> 1 lsl 6 550 | Attribute.Byval -> 1 lsl 7 551 | Attribute.Nest -> 1 lsl 8 552 | Attribute.Readnone -> 1 lsl 9 553 | Attribute.Readonly -> 1 lsl 10 554 | Attribute.Noinline -> 1 lsl 11 555 | Attribute.Alwaysinline -> 1 lsl 12 556 | Attribute.Optsize -> 1 lsl 13 557 | Attribute.Ssp -> 1 lsl 14 558 | Attribute.Sspreq -> 1 lsl 15 559 | Attribute.Alignment n -> n lsl 16 560 | Attribute.Nocapture -> 1 lsl 21 561 | Attribute.Noredzone -> 1 lsl 22 562 | Attribute.Noimplicitfloat -> 1 lsl 23 563 | Attribute.Naked -> 1 lsl 24 564 | Attribute.Inlinehint -> 1 lsl 25 565 | Attribute.Stackalignment n -> n lsl 26 566 567let add_function_attr llval attr = 568 llvm_add_function_attr llval (pack_attr attr) 569 570let remove_function_attr llval attr = 571 llvm_remove_function_attr llval (pack_attr attr) 572 573(*--... Operations on params ...............................................--*) 574external params : llvalue -> llvalue array = "llvm_params" 575external param : llvalue -> int -> llvalue = "llvm_param" 576external param_parent : llvalue -> llvalue = "LLVMGetParamParent" 577external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin" 578external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ" 579external param_end : llvalue -> (llvalue, llvalue) llrev_pos = "llvm_param_end" 580external param_pred : llvalue -> (llvalue, llvalue) llrev_pos ="llvm_param_pred" 581 582let rec iter_param_range f i e = 583 if i = e then () else 584 match i with 585 | At_end _ -> raise (Invalid_argument "Invalid parameter range.") 586 | Before p -> 587 f p; 588 iter_param_range f (param_succ p) e 589 590let iter_params f fn = 591 iter_param_range f (param_begin fn) (At_end fn) 592 593let rec fold_left_param_range f init i e = 594 if i = e then init else 595 match i with 596 | At_end _ -> raise (Invalid_argument "Invalid parameter range.") 597 | Before p -> fold_left_param_range f (f init p) (param_succ p) e 598 599let fold_left_params f init fn = 600 fold_left_param_range f init (param_begin fn) (At_end fn) 601 602let rec rev_iter_param_range f i e = 603 if i = e then () else 604 match i with 605 | At_start _ -> raise (Invalid_argument "Invalid parameter range.") 606 | After p -> 607 f p; 608 rev_iter_param_range f (param_pred p) e 609 610let rev_iter_params f fn = 611 rev_iter_param_range f (param_end fn) (At_start fn) 612 613let rec fold_right_param_range f init i e = 614 if i = e then init else 615 match i with 616 | At_start _ -> raise (Invalid_argument "Invalid parameter range.") 617 | After p -> fold_right_param_range f (f p init) (param_pred p) e 618 619let fold_right_params f fn init = 620 fold_right_param_range f init (param_end fn) (At_start fn) 621 622external llvm_add_param_attr : llvalue -> int -> unit 623 = "llvm_add_param_attr" 624external llvm_remove_param_attr : llvalue -> int -> unit 625 = "llvm_remove_param_attr" 626 627let add_param_attr llval attr = 628 llvm_add_param_attr llval (pack_attr attr) 629 630let remove_param_attr llval attr = 631 llvm_remove_param_attr llval (pack_attr attr) 632 633external set_param_alignment : llvalue -> int -> unit 634 = "llvm_set_param_alignment" 635 636(*--... Operations on basic blocks .........................................--*) 637external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" 638external value_is_block : llvalue -> bool = "llvm_value_is_block" 639external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" 640external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent" 641external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks" 642external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock" 643external delete_block : llbasicblock -> unit = "llvm_delete_block" 644external append_block : llcontext -> string -> llvalue -> llbasicblock 645 = "llvm_append_block" 646external insert_block : llcontext -> string -> llbasicblock -> llbasicblock 647 = "llvm_insert_block" 648external block_begin : llvalue -> (llvalue, llbasicblock) llpos 649 = "llvm_block_begin" 650external block_succ : llbasicblock -> (llvalue, llbasicblock) llpos 651 = "llvm_block_succ" 652external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos 653 = "llvm_block_end" 654external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos 655 = "llvm_block_pred" 656 657let rec iter_block_range f i e = 658 if i = e then () else 659 match i with 660 | At_end _ -> raise (Invalid_argument "Invalid block range.") 661 | Before bb -> 662 f bb; 663 iter_block_range f (block_succ bb) e 664 665let iter_blocks f fn = 666 iter_block_range f (block_begin fn) (At_end fn) 667 668let rec fold_left_block_range f init i e = 669 if i = e then init else 670 match i with 671 | At_end _ -> raise (Invalid_argument "Invalid block range.") 672 | Before bb -> fold_left_block_range f (f init bb) (block_succ bb) e 673 674let fold_left_blocks f init fn = 675 fold_left_block_range f init (block_begin fn) (At_end fn) 676 677let rec rev_iter_block_range f i e = 678 if i = e then () else 679 match i with 680 | At_start _ -> raise (Invalid_argument "Invalid block range.") 681 | After bb -> 682 f bb; 683 rev_iter_block_range f (block_pred bb) e 684 685let rev_iter_blocks f fn = 686 rev_iter_block_range f (block_end fn) (At_start fn) 687 688let rec fold_right_block_range f init i e = 689 if i = e then init else 690 match i with 691 | At_start _ -> raise (Invalid_argument "Invalid block range.") 692 | After bb -> fold_right_block_range f (f bb init) (block_pred bb) e 693 694let fold_right_blocks f fn init = 695 fold_right_block_range f init (block_end fn) (At_start fn) 696 697(*--... Operations on instructions .........................................--*) 698external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" 699external instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos 700 = "llvm_instr_begin" 701external instr_succ : llvalue -> (llbasicblock, llvalue) llpos 702 = "llvm_instr_succ" 703external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos 704 = "llvm_instr_end" 705external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos 706 = "llvm_instr_pred" 707 708external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate" 709 710let rec iter_instrs_range f i e = 711 if i = e then () else 712 match i with 713 | At_end _ -> raise (Invalid_argument "Invalid instruction range.") 714 | Before i -> 715 f i; 716 iter_instrs_range f (instr_succ i) e 717 718let iter_instrs f bb = 719 iter_instrs_range f (instr_begin bb) (At_end bb) 720 721let rec fold_left_instrs_range f init i e = 722 if i = e then init else 723 match i with 724 | At_end _ -> raise (Invalid_argument "Invalid instruction range.") 725 | Before i -> fold_left_instrs_range f (f init i) (instr_succ i) e 726 727let fold_left_instrs f init bb = 728 fold_left_instrs_range f init (instr_begin bb) (At_end bb) 729 730let rec rev_iter_instrs_range f i e = 731 if i = e then () else 732 match i with 733 | At_start _ -> raise (Invalid_argument "Invalid instruction range.") 734 | After i -> 735 f i; 736 rev_iter_instrs_range f (instr_pred i) e 737 738let rev_iter_instrs f bb = 739 rev_iter_instrs_range f (instr_end bb) (At_start bb) 740 741let rec fold_right_instr_range f i e init = 742 if i = e then init else 743 match i with 744 | At_start _ -> raise (Invalid_argument "Invalid instruction range.") 745 | After i -> fold_right_instr_range f (instr_pred i) e (f i init) 746 747let fold_right_instrs f bb init = 748 fold_right_instr_range f (instr_end bb) (At_start bb) init 749 750 751(*--... Operations on call sites ...........................................--*) 752external instruction_call_conv: llvalue -> int 753 = "llvm_instruction_call_conv" 754external set_instruction_call_conv: int -> llvalue -> unit 755 = "llvm_set_instruction_call_conv" 756 757external llvm_add_instruction_param_attr : llvalue -> int -> int -> unit 758 = "llvm_add_instruction_param_attr" 759external llvm_remove_instruction_param_attr : llvalue -> int -> int -> unit 760 = "llvm_remove_instruction_param_attr" 761 762let add_instruction_param_attr llval i attr = 763 llvm_add_instruction_param_attr llval i (pack_attr attr) 764 765let remove_instruction_param_attr llval i attr = 766 llvm_remove_instruction_param_attr llval i (pack_attr attr) 767 768(*--... Operations on call instructions (only) .............................--*) 769external is_tail_call : llvalue -> bool = "llvm_is_tail_call" 770external set_tail_call : bool -> llvalue -> unit = "llvm_set_tail_call" 771 772(*--... Operations on phi nodes ............................................--*) 773external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit 774 = "llvm_add_incoming" 775external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" 776 777 778(*===-- Instruction builders ----------------------------------------------===*) 779external builder : llcontext -> llbuilder = "llvm_builder" 780external position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit 781 = "llvm_position_builder" 782external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" 783external insert_into_builder : llvalue -> string -> llbuilder -> unit 784 = "llvm_insert_into_builder" 785 786let builder_at context ip = 787 let b = builder context in 788 position_builder ip b; 789 b 790 791let builder_before context i = builder_at context (Before i) 792let builder_at_end context bb = builder_at context (At_end bb) 793 794let position_before i = position_builder (Before i) 795let position_at_end bb = position_builder (At_end bb) 796 797 798(*--... Metadata ...........................................................--*) 799external set_current_debug_location : llbuilder -> llvalue -> unit 800 = "llvm_set_current_debug_location" 801external clear_current_debug_location : llbuilder -> unit 802 = "llvm_clear_current_debug_location" 803external current_debug_location : llbuilder -> llvalue option 804 = "llvm_current_debug_location" 805external set_inst_debug_location : llbuilder -> llvalue -> unit 806 = "llvm_set_inst_debug_location" 807 808 809(*--... Terminators ........................................................--*) 810external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void" 811external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret" 812external build_aggregate_ret : llvalue array -> llbuilder -> llvalue 813 = "llvm_build_aggregate_ret" 814external build_br : llbasicblock -> llbuilder -> llvalue = "llvm_build_br" 815external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder -> 816 llvalue = "llvm_build_cond_br" 817external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue 818 = "llvm_build_switch" 819external add_case : llvalue -> llvalue -> llbasicblock -> unit 820 = "llvm_add_case" 821external build_indirect_br : llvalue -> int -> llbuilder -> llvalue 822 = "llvm_build_indirect_br" 823external add_destination : llvalue -> llbasicblock -> unit 824 = "llvm_add_destination" 825external build_invoke : llvalue -> llvalue array -> llbasicblock -> 826 llbasicblock -> string -> llbuilder -> llvalue 827 = "llvm_build_invoke_bc" "llvm_build_invoke_nat" 828external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder -> 829 llvalue = "llvm_build_landingpad" 830external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup" 831external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable" 832 833(*--... Arithmetic .........................................................--*) 834external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 835 = "llvm_build_add" 836external build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 837 = "llvm_build_nsw_add" 838external build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 839 = "llvm_build_nuw_add" 840external build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue 841 = "llvm_build_fadd" 842external build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 843 = "llvm_build_sub" 844external build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 845 = "llvm_build_nsw_sub" 846external build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 847 = "llvm_build_nuw_sub" 848external build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue 849 = "llvm_build_fsub" 850external build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 851 = "llvm_build_mul" 852external build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 853 = "llvm_build_nsw_mul" 854external build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 855 = "llvm_build_nuw_mul" 856external build_fmul : llvalue -> llvalue -> string -> llbuilder -> llvalue 857 = "llvm_build_fmul" 858external build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 859 = "llvm_build_udiv" 860external build_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 861 = "llvm_build_sdiv" 862external build_exact_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 863 = "llvm_build_exact_sdiv" 864external build_fdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 865 = "llvm_build_fdiv" 866external build_urem : llvalue -> llvalue -> string -> llbuilder -> llvalue 867 = "llvm_build_urem" 868external build_srem : llvalue -> llvalue -> string -> llbuilder -> llvalue 869 = "llvm_build_srem" 870external build_frem : llvalue -> llvalue -> string -> llbuilder -> llvalue 871 = "llvm_build_frem" 872external build_shl : llvalue -> llvalue -> string -> llbuilder -> llvalue 873 = "llvm_build_shl" 874external build_lshr : llvalue -> llvalue -> string -> llbuilder -> llvalue 875 = "llvm_build_lshr" 876external build_ashr : llvalue -> llvalue -> string -> llbuilder -> llvalue 877 = "llvm_build_ashr" 878external build_and : llvalue -> llvalue -> string -> llbuilder -> llvalue 879 = "llvm_build_and" 880external build_or : llvalue -> llvalue -> string -> llbuilder -> llvalue 881 = "llvm_build_or" 882external build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue 883 = "llvm_build_xor" 884external build_neg : llvalue -> string -> llbuilder -> llvalue 885 = "llvm_build_neg" 886external build_nsw_neg : llvalue -> string -> llbuilder -> llvalue 887 = "llvm_build_nsw_neg" 888external build_nuw_neg : llvalue -> string -> llbuilder -> llvalue 889 = "llvm_build_nuw_neg" 890external build_fneg : llvalue -> string -> llbuilder -> llvalue 891 = "llvm_build_fneg" 892external build_not : llvalue -> string -> llbuilder -> llvalue 893 = "llvm_build_not" 894 895(*--... Memory .............................................................--*) 896external build_alloca : lltype -> string -> llbuilder -> llvalue 897 = "llvm_build_alloca" 898external build_array_alloca : lltype -> llvalue -> string -> llbuilder -> 899 llvalue = "llvm_build_array_alloca" 900external build_load : llvalue -> string -> llbuilder -> llvalue 901 = "llvm_build_load" 902external build_store : llvalue -> llvalue -> llbuilder -> llvalue 903 = "llvm_build_store" 904external build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue 905 = "llvm_build_gep" 906external build_in_bounds_gep : llvalue -> llvalue array -> string -> 907 llbuilder -> llvalue = "llvm_build_in_bounds_gep" 908external build_struct_gep : llvalue -> int -> string -> llbuilder -> llvalue 909 = "llvm_build_struct_gep" 910 911external build_global_string : string -> string -> llbuilder -> llvalue 912 = "llvm_build_global_string" 913external build_global_stringptr : string -> string -> llbuilder -> llvalue 914 = "llvm_build_global_stringptr" 915 916(*--... Casts ..............................................................--*) 917external build_trunc : llvalue -> lltype -> string -> llbuilder -> llvalue 918 = "llvm_build_trunc" 919external build_zext : llvalue -> lltype -> string -> llbuilder -> llvalue 920 = "llvm_build_zext" 921external build_sext : llvalue -> lltype -> string -> llbuilder -> llvalue 922 = "llvm_build_sext" 923external build_fptoui : llvalue -> lltype -> string -> llbuilder -> llvalue 924 = "llvm_build_fptoui" 925external build_fptosi : llvalue -> lltype -> string -> llbuilder -> llvalue 926 = "llvm_build_fptosi" 927external build_uitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 928 = "llvm_build_uitofp" 929external build_sitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 930 = "llvm_build_sitofp" 931external build_fptrunc : llvalue -> lltype -> string -> llbuilder -> llvalue 932 = "llvm_build_fptrunc" 933external build_fpext : llvalue -> lltype -> string -> llbuilder -> llvalue 934 = "llvm_build_fpext" 935external build_ptrtoint : llvalue -> lltype -> string -> llbuilder -> llvalue 936 = "llvm_build_prttoint" 937external build_inttoptr : llvalue -> lltype -> string -> llbuilder -> llvalue 938 = "llvm_build_inttoptr" 939external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue 940 = "llvm_build_bitcast" 941external build_zext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 942 llvalue = "llvm_build_zext_or_bitcast" 943external build_sext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 944 llvalue = "llvm_build_sext_or_bitcast" 945external build_trunc_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 946 llvalue = "llvm_build_trunc_or_bitcast" 947external build_pointercast : llvalue -> lltype -> string -> llbuilder -> llvalue 948 = "llvm_build_pointercast" 949external build_intcast : llvalue -> lltype -> string -> llbuilder -> llvalue 950 = "llvm_build_intcast" 951external build_fpcast : llvalue -> lltype -> string -> llbuilder -> llvalue 952 = "llvm_build_fpcast" 953 954(*--... Comparisons ........................................................--*) 955external build_icmp : Icmp.t -> llvalue -> llvalue -> string -> 956 llbuilder -> llvalue = "llvm_build_icmp" 957external build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> 958 llbuilder -> llvalue = "llvm_build_fcmp" 959 960(*--... Miscellaneous instructions .........................................--*) 961external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder -> 962 llvalue = "llvm_build_phi" 963external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue 964 = "llvm_build_call" 965external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder -> 966 llvalue = "llvm_build_select" 967external build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue 968 = "llvm_build_va_arg" 969external build_extractelement : llvalue -> llvalue -> string -> llbuilder -> 970 llvalue = "llvm_build_extractelement" 971external build_insertelement : llvalue -> llvalue -> llvalue -> string -> 972 llbuilder -> llvalue = "llvm_build_insertelement" 973external build_shufflevector : llvalue -> llvalue -> llvalue -> string -> 974 llbuilder -> llvalue = "llvm_build_shufflevector" 975external build_extractvalue : llvalue -> int -> string -> llbuilder -> llvalue 976 = "llvm_build_extractvalue" 977external build_insertvalue : llvalue -> llvalue -> int -> string -> llbuilder -> 978 llvalue = "llvm_build_insertvalue" 979 980external build_is_null : llvalue -> string -> llbuilder -> llvalue 981 = "llvm_build_is_null" 982external build_is_not_null : llvalue -> string -> llbuilder -> llvalue 983 = "llvm_build_is_not_null" 984external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue 985 = "llvm_build_ptrdiff" 986 987 988(*===-- Memory buffers ----------------------------------------------------===*) 989 990module MemoryBuffer = struct 991 external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file" 992 external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin" 993 external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose" 994end 995 996 997(*===-- Pass Manager ------------------------------------------------------===*) 998 999module PassManager = struct 1000 type 'a t 1001 type any = [ `Module | `Function ] 1002 external create : unit -> [ `Module ] t = "llvm_passmanager_create" 1003 external create_function : llmodule -> [ `Function ] t 1004 = "LLVMCreateFunctionPassManager" 1005 external run_module : llmodule -> [ `Module ] t -> bool 1006 = "llvm_passmanager_run_module" 1007 external initialize : [ `Function ] t -> bool = "llvm_passmanager_initialize" 1008 external run_function : llvalue -> [ `Function ] t -> bool 1009 = "llvm_passmanager_run_function" 1010 external finalize : [ `Function ] t -> bool = "llvm_passmanager_finalize" 1011 external dispose : [< any ] t -> unit = "llvm_passmanager_dispose" 1012end 1013 1014 1015(*===-- Non-Externs -------------------------------------------------------===*) 1016(* These functions are built using the externals, so must be declared late. *) 1017 1018let concat2 sep arr = 1019 let s = ref "" in 1020 if 0 < Array.length arr then begin 1021 s := !s ^ arr.(0); 1022 for i = 1 to (Array.length arr) - 1 do 1023 s := !s ^ sep ^ arr.(i) 1024 done 1025 end; 1026 !s 1027 1028let rec string_of_lltype ty = 1029 (* FIXME: stop infinite recursion! :) *) 1030 match classify_type ty with 1031 TypeKind.Integer -> "i" ^ string_of_int (integer_bitwidth ty) 1032 | TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*" 1033 | TypeKind.Struct -> 1034 let s = "{ " ^ (concat2 ", " ( 1035 Array.map string_of_lltype (struct_element_types ty) 1036 )) ^ " }" in 1037 if is_packed ty 1038 then "<" ^ s ^ ">" 1039 else s 1040 | TypeKind.Array -> "[" ^ (string_of_int (array_length ty)) ^ 1041 " x " ^ (string_of_lltype (element_type ty)) ^ "]" 1042 | TypeKind.Vector -> "<" ^ (string_of_int (vector_size ty)) ^ 1043 " x " ^ (string_of_lltype (element_type ty)) ^ ">" 1044 | TypeKind.Function -> string_of_lltype (return_type ty) ^ 1045 " (" ^ (concat2 ", " ( 1046 Array.map string_of_lltype (param_types ty) 1047 )) ^ ")" 1048 | TypeKind.Label -> "label" 1049 | TypeKind.Ppc_fp128 -> "ppc_fp128" 1050 | TypeKind.Fp128 -> "fp128" 1051 | TypeKind.X86fp80 -> "x86_fp80" 1052 | TypeKind.Double -> "double" 1053 | TypeKind.Float -> "float" 1054 | TypeKind.Void -> "void" 1055 | TypeKind.Metadata -> "metadata" 1056