llvm.org GIT mirror llvm / 8a3bdd6
[OCaml] Implement missing LLVMCore APIs git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@193966 91177308-0d34-0410-b5e6-96231b3b80d8 Peter Zotov 7 years ago
4 changed file(s) with 396 addition(s) and 68 deletion(s). Raw diff Collapse all Expand all
3333 | Pointer
3434 | Vector
3535 | Metadata
36 | X86_mmx
3637 end
3738
3839 module Linkage = struct
4142 | Available_externally
4243 | Link_once
4344 | Link_once_odr
45 | Link_once_odr_auto_hide
4446 | Weak
4547 | Weak_odr
4648 | Appending
5254 | Ghost
5355 | Common
5456 | Linker_private
57 | Linker_private_weak
5558 end
5659
5760 module Visibility = struct
201204 | AtomicRMW
202205 | Resume
203206 | LandingPad
204 | Unwind
207 end
208
209 module LandingPadClauseTy = struct
210 type t =
211 | Catch
212 | Filter
213 end
214
215 module ThreadLocalMode = struct
216 type t =
217 | None
218 | GeneralDynamic
219 | LocalDynamic
220 | InitialExec
221 | LocalExec
222 end
223
224 module AtomicOrdering = struct
225 type t =
226 | NotAtomic
227 | Unordered
228 | Monotonic
229 | Invalid
230 | Acquire
231 | Release
232 | AcqiureRelease
233 | SequentiallyConsistent
234 end
235
236 module AtomicRMWBinOp = struct
237 type t =
238 | Xchg
239 | Add
240 | Sub
241 | And
242 | Nand
243 | Or
244 | Xor
245 | Max
246 | Min
247 | UMax
248 | UMin
205249 end
206250
207251 module ValueKind = struct
259303 external set_data_layout: string -> llmodule -> unit
260304 = "llvm_set_data_layout"
261305 external dump_module : llmodule -> unit = "llvm_dump_module"
306 external print_module : string -> llmodule -> unit = "llvm_print_module"
307 external string_of_llmodule : llmodule -> string = "llvm_string_of_llmodule"
262308 external set_module_inline_asm : llmodule -> string -> unit
263309 = "llvm_set_module_inline_asm"
264310 external module_context : llmodule -> llcontext = "LLVMGetModuleContext"
267313 external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
268314 external type_context : lltype -> llcontext = "llvm_type_context"
269315 external type_is_sized : lltype -> bool = "llvm_type_is_sized"
316 external dump_type : lltype -> unit = "llvm_dump_type"
317 external string_of_lltype : lltype -> string = "llvm_string_of_lltype"
270318
271319 (*--... Operations on integer types ........................................--*)
272320 external i1_type : llcontext -> lltype = "llvm_i1_type"
322370 (*--... Operations on other types ..........................................--*)
323371 external void_type : llcontext -> lltype = "llvm_void_type"
324372 external label_type : llcontext -> lltype = "llvm_label_type"
373 external x86_mmx_type : llcontext -> lltype = "llvm_x86_mmx_type"
325374 external type_by_name : llmodule -> string -> lltype option = "llvm_type_by_name"
326375
327376 external classify_value : llvalue -> ValueKind.t = "llvm_classify_value"
390439 external mdstring : llcontext -> string -> llvalue = "llvm_mdstring"
391440 external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode"
392441 external get_mdstring : llvalue -> string option = "llvm_get_mdstring"
393 external get_named_metadata : llmodule -> string -> llvalue array = "llvm_get_namedmd"
442 external get_named_metadata : llmodule -> string -> llvalue array
443 = "llvm_get_namedmd"
444 external add_named_metadata_operand : llmodule -> string -> llvalue -> unit
445 = "llvm_append_namedmd"
394446
395447 (*--... Operations on scalar constants .....................................--*)
396448 external const_int : lltype -> int -> llvalue = "llvm_const_int"
529581 external remove_initializer : llvalue -> unit = "llvm_remove_initializer"
530582 external is_thread_local : llvalue -> bool = "llvm_is_thread_local"
531583 external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local"
584 external thread_local_mode : llvalue -> ThreadLocalMode.t
585 = "llvm_thread_local_mode"
586 external set_thread_local_mode : ThreadLocalMode.t -> llvalue -> unit
587 = "llvm_set_thread_local_mode"
588 external is_externally_initialized : llvalue -> bool
589 = "llvm_is_externally_initialized"
590 external set_externally_initialized : bool -> llvalue -> unit
591 = "llvm_set_externally_initialized"
532592 external global_begin : llmodule -> (llmodule, llvalue) llpos
533593 = "llvm_global_begin"
534594 external global_succ : llvalue -> (llmodule, llvalue) llpos
724784 let add_function_attr llval attr =
725785 llvm_add_function_attr llval (pack_attr attr)
726786
787 external add_target_dependent_function_attr
788 : llvalue -> string -> string -> unit
789 = "llvm_add_target_dependent_function_attr"
790
727791 let remove_function_attr llval attr =
728792 llvm_remove_function_attr llval (pack_attr attr)
729793
802866 external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks"
803867 external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock"
804868 external delete_block : llbasicblock -> unit = "llvm_delete_block"
869 external remove_block : llbasicblock -> unit = "llvm_remove_block"
870 external move_block_before : llbasicblock -> llbasicblock -> unit
871 = "llvm_move_block_before"
872 external move_block_after : llbasicblock -> llbasicblock -> unit
873 = "llvm_move_block_after"
805874 external append_block : llcontext -> string -> llvalue -> llbasicblock
806875 = "llvm_append_block"
807876 external insert_block : llcontext -> string -> llbasicblock -> llbasicblock
871940 external instr_opcode : llvalue -> Opcode.t = "llvm_instr_get_opcode"
872941 external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate"
873942
874 external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate"
875
876943 let rec iter_instrs_range f i e =
877944 if i = e then () else
878945 match i with
9341001 (*--... Operations on call instructions (only) .............................--*)
9351002 external is_tail_call : llvalue -> bool = "llvm_is_tail_call"
9361003 external set_tail_call : bool -> llvalue -> unit = "llvm_set_tail_call"
1004
1005 (*--... Operations on load/store instructions (only) .......................--*)
1006 external is_volatile : llvalue -> bool = "llvm_is_volatile"
1007 external set_volatile : bool -> llvalue -> unit = "llvm_set_volatile"
9371008
9381009 (*--... Operations on phi nodes ............................................--*)
9391010 external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
10771148 = "llvm_build_load"
10781149 external build_store : llvalue -> llvalue -> llbuilder -> llvalue
10791150 = "llvm_build_store"
1151 external build_atomicrmw : AtomicRMWBinOp.t -> llvalue -> llvalue ->
1152 AtomicOrdering.t -> bool -> string -> llbuilder ->
1153 llvalue
1154 = "llvm_build_atomicrmw_bytecode"
1155 "llvm_build_atomicrmw_native"
10801156 external build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue
10811157 = "llvm_build_gep"
10821158 external build_in_bounds_gep : llvalue -> llvalue array -> string ->
11661242 module MemoryBuffer = struct
11671243 external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file"
11681244 external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin"
1169 external of_string : ?name:string -> string -> llmemorybuffer = "llvm_memorybuffer_of_string"
1245 external of_string : ?name:string -> string -> llmemorybuffer
1246 = "llvm_memorybuffer_of_string"
11701247 external as_string : llmemorybuffer -> string = "llvm_memorybuffer_as_string"
11711248 external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose"
11721249 end
11881265 external finalize : [ `Function ] t -> bool = "llvm_passmanager_finalize"
11891266 external dispose : [< any ] t -> unit = "llvm_passmanager_dispose"
11901267 end
1191
1192
1193 (*===-- Non-Externs -------------------------------------------------------===*)
1194 (* These functions are built using the externals, so must be declared late. *)
1195
1196 let concat2 sep arr =
1197 let s = ref "" in
1198 if 0 < Array.length arr then begin
1199 s := !s ^ arr.(0);
1200 for i = 1 to (Array.length arr) - 1 do
1201 s := !s ^ sep ^ arr.(i)
1202 done
1203 end;
1204 !s
1205
1206 let rec string_of_lltype ty =
1207 (* FIXME: stop infinite recursion! :) *)
1208 match classify_type ty with
1209 TypeKind.Integer -> "i" ^ string_of_int (integer_bitwidth ty)
1210 | TypeKind.Pointer ->
1211 (let ety = element_type ty in
1212 match classify_type ety with
1213 | TypeKind.Struct ->
1214 (match struct_name ety with
1215 | None -> (string_of_lltype ety)
1216 | Some s -> s) ^ "*"
1217 | _ -> (string_of_lltype (element_type ty)) ^ "*")
1218 | TypeKind.Struct ->
1219 let s = "{ " ^ (concat2 ", " (
1220 Array.map string_of_lltype (struct_element_types ty)
1221 )) ^ " }" in
1222 if is_packed ty
1223 then "<" ^ s ^ ">"
1224 else s
1225 | TypeKind.Array -> "[" ^ (string_of_int (array_length ty)) ^
1226 " x " ^ (string_of_lltype (element_type ty)) ^ "]"
1227 | TypeKind.Vector -> "<" ^ (string_of_int (vector_size ty)) ^
1228 " x " ^ (string_of_lltype (element_type ty)) ^ ">"
1229 | TypeKind.Function -> string_of_lltype (return_type ty) ^
1230 " (" ^ (concat2 ", " (
1231 Array.map string_of_lltype (param_types ty)
1232 )) ^ ")"
1233 | TypeKind.Label -> "label"
1234 | TypeKind.Ppc_fp128 -> "ppc_fp128"
1235 | TypeKind.Fp128 -> "fp128"
1236 | TypeKind.X86fp80 -> "x86_fp80"
1237 | TypeKind.Double -> "double"
1238 | TypeKind.Float -> "float"
1239 | TypeKind.Half -> "half"
1240 | TypeKind.Void -> "void"
1241 | TypeKind.Metadata -> "metadata"
6666 | Pointer
6767 | Vector
6868 | Metadata
69 | X86_mmx
6970 end
7071
7172 (** The linkage of a global value, accessed with {!linkage} and
7677 | Available_externally
7778 | Link_once
7879 | Link_once_odr
80 | Link_once_odr_auto_hide
7981 | Weak
8082 | Weak_odr
8183 | Appending
8789 | Ghost
8890 | Common
8991 | Linker_private
92 | Linker_private_weak
9093 end
9194
9295 (** The linker visibility of a global value, accessed with {!visibility} and
251254 | AtomicRMW
252255 | Resume
253256 | LandingPad
254 | Unwind
257 end
258
259 (** The type of a clause of a [landingpad] instruction.
260 See [llvm::LandingPadInst::ClauseType]. *)
261 module LandingPadClauseTy : sig
262 type t =
263 | Catch
264 | Filter
265 end
266
267 (** The thread local mode of a global value, accessed with {!thread_local_mode}
268 and {!set_thread_local_mode}.
269 See [llvm::GlobalVariable::ThreadLocalMode]. *)
270 module ThreadLocalMode : sig
271 type t =
272 | None
273 | GeneralDynamic
274 | LocalDynamic
275 | InitialExec
276 | LocalExec
277 end
278
279 (** The ordering of an atomic [load], [store], [cmpxchg], [atomicrmw] or
280 [fence] instruction. See [llvm::AtomicOrdering]. *)
281 module AtomicOrdering : sig
282 type t =
283 | NotAtomic
284 | Unordered
285 | Monotonic
286 | Invalid (* removed due to API changes *)
287 | Acquire
288 | Release
289 | AcqiureRelease
290 | SequentiallyConsistent
291 end
292
293 (** The opcode of an [atomicrmw] instruction.
294 See [llvm::AtomicRMWInst::BinOp]. *)
295 module AtomicRMWBinOp : sig
296 type t =
297 | Xchg
298 | Add
299 | Sub
300 | And
301 | Nand
302 | Or
303 | Xor
304 | Max
305 | Min
306 | UMax
307 | UMin
255308 end
256309
257310 (** The kind of an [llvalue], the result of [classify_value v].
357410 error. See the method [llvm::Module::dump]. *)
358411 val dump_module : llmodule -> unit
359412
413 (** [print_module f m] prints the .ll representation of the module [m]
414 to file [f]. See the method [llvm::Module::print]. *)
415 val print_module : string -> llmodule -> unit
416
417 (** [string_of_llmodule m] returns the .ll representation of the module [m]
418 as a string. See the method [llvm::Module::print]. *)
419 val string_of_llmodule : llmodule -> string
420
360421 (** [set_module_inline_asm m asm] sets the inline assembler for the module. See
361422 the method [llvm::Module::setModuleInlineAsm]. *)
362423 val set_module_inline_asm : llmodule -> string -> unit
380441 (** [type_context ty] returns the {!llcontext} corresponding to the type [ty].
381442 See the method [llvm::Type::getContext]. *)
382443 val type_context : lltype -> llcontext
444
445 (** [dump_type ty] prints the .ll representation of the type [ty] to standard
446 error. See the method [llvm::Type::dump]. *)
447 val dump_type : lltype -> unit
383448
384449 (** [string_of_lltype ty] returns a string describing the type [ty]. *)
385450 val string_of_lltype : lltype -> string
551616 [llvm::Type::LabelTy]. *)
552617 val label_type : llcontext -> lltype
553618
619 (** [x86_mmx_type c] returns the x86 64-bit MMX register type in the
620 context [c]. See [llvm::Type::X86_MMXTy]. *)
621 val x86_mmx_type : llcontext -> lltype
622
554623 (** [type_by_name m name] returns the specified type from the current module
555624 if it exists.
556625 See the method [llvm::Module::getTypeByName] *)
705774 metadata (if any).
706775 See the method [llvm::NamedMDNode::getOperand]. *)
707776 val get_named_metadata : llmodule -> string -> llvalue array
777
778 (** [add_named_metadata_operand m name v] adds [v] as the last operand of
779 metadata named [name] in module [m]. If the metadata does not exist,
780 it is created.
781 See the methods [llvm::Module::getNamedMetadata()] and
782 [llvm::MDNode::addOperand()]. *)
783 val add_named_metadata_operand : llmodule -> string -> llvalue -> unit
708784
709785
710786 (** {7 Operations on scalar constants} *)
12421318 See the method [llvm::GlobalVariable::setThreadLocal]. *)
12431319 val set_thread_local : bool -> llvalue -> unit
12441320
1321 (** [is_thread_local gv] returns the thread local mode of the global
1322 variable [gv].
1323 See the method [llvm::GlobalVariable::getThreadLocalMode]. *)
1324 val thread_local_mode : llvalue -> ThreadLocalMode.t
1325
1326 (** [set_thread_local c gv] sets the thread local mode of the global
1327 variable [gv].
1328 See the method [llvm::GlobalVariable::setThreadLocalMode]. *)
1329 val set_thread_local_mode : ThreadLocalMode.t -> llvalue -> unit
1330
1331 (** [is_externally_initialized gv] returns [true] if the global
1332 variable [gv] is externally initialized and [false] otherwise.
1333 See the method [llvm::GlobalVariable::isExternallyInitialized]. *)
1334 val is_externally_initialized : llvalue -> bool
1335
1336 (** [set_externally_initialized c gv] sets the global variable [gv] to be
1337 externally initialized if [c] is [true] and not otherwise.
1338 See the method [llvm::GlobalVariable::setExternallyInitialized]. *)
1339 val set_externally_initialized : bool -> llvalue -> unit
1340
12451341
12461342 (** {7 Operations on aliases} *)
12471343
13371433 [f]. *)
13381434 val add_function_attr : llvalue -> Attribute.t -> unit
13391435
1436 (** [add_target_dependent_function_attr f a] adds target-dependent attribute
1437 [a] to function [f]. *)
1438 val add_target_dependent_function_attr : llvalue -> string -> string -> unit
1439
13401440 (** [function_attr f] returns the function attribute for the function [f].
13411441 See the method [llvm::Function::getAttributes] *)
13421442 val function_attr : llvalue -> Attribute.t list
14251525 (** [delete_block bb] deletes the basic block [bb].
14261526 See the method [llvm::BasicBlock::eraseFromParent]. *)
14271527 val delete_block : llbasicblock -> unit
1528
1529 (** [remove_block bb] removes the basic block [bb] from its parent function.
1530 See the method [llvm::BasicBlock::removeFromParent]. *)
1531 val remove_block : llbasicblock -> unit
1532
1533 (** [move_block_before pos bb] moves the basic block [bb] before [pos].
1534 See the method [llvm::BasicBlock::moveBefore]. *)
1535 val move_block_before : llbasicblock -> llbasicblock -> unit
1536
1537 (** [move_block_after pos bb] moves the basic block [bb] after [pos].
1538 See the method [llvm::BasicBlock::moveAfter]. *)
1539 val move_block_after : llbasicblock -> llbasicblock -> unit
14281540
14291541 (** [append_block c name f] creates a new basic block named [name] at the end of
14301542 function [f] in the context [c].
15731685 val set_tail_call : bool -> llvalue -> unit
15741686
15751687
1688 (** {7 Operations on load/store instructions (only)} *)
1689
1690 (** [is_volatile i] is [true] if the load or store instruction [i] is marked
1691 as volatile.
1692 See the methods [llvm::LoadInst::isVolatile] and
1693 [llvm::StoreInst::isVolatile]. *)
1694 val is_volatile : llvalue -> bool
1695
1696 (** [set_volatile v i] marks the load or store instruction [i] as volatile
1697 if [v] is [true], unmarks otherwise.
1698 See the methods [llvm::LoadInst::setVolatile] and
1699 [llvm::StoreInst::setVolatile]. *)
1700 val set_volatile : bool -> llvalue -> unit
1701
1702
15761703 (** {7 Operations on phi nodes} *)
15771704
15781705 (** [add_incoming (v, bb) pn] adds the value [v] to the phi node [pn] for use
19802107 instruction at the position specified by the instruction builder [b].
19812108 See the method [llvm::LLVMBuilder::CreateStore]. *)
19822109 val build_store : llvalue -> llvalue -> llbuilder -> llvalue
2110
2111 (** [build_atomicrmw op ptr val o st b] creates an [atomicrmw] instruction with
2112 operation [op] performed on pointer [ptr] and value [val] with ordering [o]
2113 and singlethread flag set to [st] at the position specified by
2114 the instruction builder [b].
2115 See the method [llvm::IRBuilder::CreateAtomicRMW]. *)
2116 val build_atomicrmw : AtomicRMWBinOp.t -> llvalue -> llvalue ->
2117 AtomicOrdering.t -> bool -> string -> llbuilder -> llvalue
19832118
19842119 (** [build_gep p indices name b] creates a
19852120 [%name = getelementptr %p, indices...]
157157 return Val_unit;
158158 }
159159
160 /* string -> llmodule -> unit */
161 CAMLprim value llvm_print_module(value Filename, LLVMModuleRef M) {
162 char* Message;
163 if(LLVMPrintModuleToFile(M, String_val(Filename), &Message)) {
164 llvm_raise(llvm_ioerror_exn, Message);
165 }
166
167 return Val_unit;
168 }
169
170 /* llmodule -> string */
171 CAMLprim value llvm_string_of_llmodule(LLVMModuleRef M) {
172 char* ModuleCStr;
173 ModuleCStr = LLVMPrintModuleToString(M);
174
175 value ModuleStr = caml_copy_string(ModuleCStr);
176 LLVMDisposeMessage(ModuleCStr);
177
178 return ModuleStr;
179 }
180
160181 /* llmodule -> string -> unit */
161182 CAMLprim value llvm_set_module_inline_asm(LLVMModuleRef M, value Asm) {
162183 LLVMSetModuleInlineAsm(M, String_val(Asm));
179200 return LLVMGetTypeContext(Ty);
180201 }
181202
203 /* lltype -> unit */
204 CAMLprim value llvm_dump_type(LLVMTypeRef Val) {
205 LLVMDumpType(Val);
206 return Val_unit;
207 }
208
209 /* lltype -> string */
210 CAMLprim value llvm_string_of_lltype(LLVMTypeRef M) {
211 char* TypeCStr;
212 TypeCStr = LLVMPrintTypeToString(M);
213
214 value TypeStr = caml_copy_string(TypeCStr);
215 LLVMDisposeMessage(TypeCStr);
216
217 return TypeStr;
218 }
219
182220 /*--... Operations on integer types ........................................--*/
183221
184222 /* llcontext -> lltype */
241279 /* llcontext -> lltype */
242280 CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) {
243281 return LLVMPPCFP128TypeInContext(Context);
244 }
245
246 /* llcontext -> lltype */
247 CAMLprim LLVMTypeRef llvm_x86mmx_type(LLVMContextRef Context) {
248 return LLVMX86MMXTypeInContext(Context);
249282 }
250283
251284 /*--... Operations on function types .......................................--*/
383416 /* llcontext -> lltype */
384417 CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
385418 return LLVMLabelTypeInContext(Context);
419 }
420
421 /* llcontext -> lltype */
422 CAMLprim LLVMTypeRef llvm_x86_mmx_type(LLVMContextRef Context) {
423 return LLVMX86MMXTypeInContext(Context);
386424 }
387425
388426 CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
604642 LLVMGetNamedMetadataOperands(M, String_val(Name), (LLVMValueRef *) Nodes);
605643 CAMLreturn(Nodes);
606644 }
645
646 /* llmodule -> string -> llvalue -> unit */
647 CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef Val) {
648 LLVMAddNamedMetadataOperand(M, String_val(Name), Val);
649 return Val_unit;
650 }
651
607652 /*--... Operations on scalar constants .....................................--*/
608653
609654 /* lltype -> int -> llvalue */
948993 CAMLprim value llvm_set_thread_local(value IsThreadLocal,
949994 LLVMValueRef GlobalVar) {
950995 LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal));
996 return Val_unit;
997 }
998
999 /* llvalue -> ThreadLocalMode.t */
1000 CAMLprim value llvm_thread_local_mode(LLVMValueRef GlobalVar) {
1001 return Val_int(LLVMGetThreadLocalMode(GlobalVar));
1002 }
1003
1004 /* ThreadLocalMode.t -> llvalue -> unit */
1005 CAMLprim value llvm_set_thread_local_mode(value ThreadLocalMode,
1006 LLVMValueRef GlobalVar) {
1007 LLVMSetThreadLocalMode(GlobalVar, Int_val(ThreadLocalMode));
1008 return Val_unit;
1009 }
1010
1011 /* llvalue -> bool */
1012 CAMLprim value llvm_is_externally_initialized(LLVMValueRef GlobalVar) {
1013 return Val_bool(LLVMIsExternallyInitialized(GlobalVar));
1014 }
1015
1016 /* bool -> llvalue -> unit */
1017 CAMLprim value llvm_set_externally_initialized(value IsExternallyInitialized,
1018 LLVMValueRef GlobalVar) {
1019 LLVMSetExternallyInitialized(GlobalVar, Bool_val(IsExternallyInitialized));
9511020 return Val_unit;
9521021 }
9531022
10571126 return Val_unit;
10581127 }
10591128
1129 /* llvalue -> string -> string -> unit */
1130 CAMLprim value llvm_add_target_dependent_function_attr(
1131 LLVMValueRef Arg, value A, value V) {
1132 LLVMAddTargetDependentFunctionAttr(Arg, String_val(A), String_val(V));
1133 return Val_unit;
1134 }
1135
10601136 /* llvalue -> int32 */
10611137 CAMLprim value llvm_function_attr(LLVMValueRef Fn)
10621138 {
11411217 return Val_unit;
11421218 }
11431219
1220 /* llbasicblock -> unit */
1221 CAMLprim value llvm_remove_block(LLVMBasicBlockRef BB) {
1222 LLVMRemoveBasicBlockFromParent(BB);
1223 return Val_unit;
1224 }
1225
1226 /* llbasicblock -> llbasicblock -> unit */
1227 CAMLprim value llvm_move_block_before(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1228 LLVMMoveBasicBlockBefore(BB, Pos);
1229 return Val_unit;
1230 }
1231
1232 /* llbasicblock -> llbasicblock -> unit */
1233 CAMLprim value llvm_move_block_after(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1234 LLVMMoveBasicBlockAfter(BB, Pos);
1235 return Val_unit;
1236 }
1237
11441238 /* string -> llvalue -> llbasicblock */
11451239 CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
11461240 LLVMValueRef Fn) {
12261320 CAMLprim value llvm_set_tail_call(value IsTailCall,
12271321 LLVMValueRef CallInst) {
12281322 LLVMSetTailCall(CallInst, Bool_val(IsTailCall));
1323 return Val_unit;
1324 }
1325
1326 /*--... Operations on load/store instructions (only)........................--*/
1327
1328 /* llvalue -> bool */
1329 CAMLprim value llvm_is_volatile(LLVMValueRef MemoryInst) {
1330 return Val_bool(LLVMGetVolatile(MemoryInst));
1331 }
1332
1333 /* bool -> llvalue -> unit */
1334 CAMLprim value llvm_set_volatile(value IsVolatile,
1335 LLVMValueRef MemoryInst) {
1336 LLVMSetVolatile(MemoryInst, Bool_val(IsVolatile));
12291337 return Val_unit;
12301338 }
12311339
17001808 return LLVMBuildStore(Builder_val(B), Value, Pointer);
17011809 }
17021810
1811 /* AtomicRMWBinOp.t -> llvalue -> llvalue -> AtomicOrdering.t ->
1812 bool -> llbuilder -> llvalue */
1813 CAMLprim LLVMValueRef llvm_build_atomicrmw_native(value BinOp, LLVMValueRef Ptr,
1814 LLVMValueRef Val, value Ord,
1815 value ST, value Name, value B) {
1816 LLVMValueRef Instr;
1817 Instr = LLVMBuildAtomicRMW(Builder_val(B), Int_val(BinOp),
1818 Ptr, Val, Int_val(Ord), Bool_val(ST));
1819 LLVMSetValueName(Instr, String_val(Name));
1820 return Instr;
1821 }
1822
1823 CAMLprim LLVMValueRef llvm_build_atomicrmw_bytecode(value *argv, int argn) {
1824 return llvm_build_atomicrmw_native(argv[0], (LLVMValueRef) argv[1],
1825 (LLVMValueRef) argv[2], argv[3],
1826 argv[4], argv[5], argv[6]);
1827 }
1828
17031829 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
17041830 CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices,
17051831 value Name, value B) {
451451 set_thread_local true in
452452 insist (is_thread_local g);
453453
454 (* CHECK-NOWHERE-NOT: GVar05
454 (* CHECK: GVar05{{.*}}thread_local(initialexec)
455 *)
456 group "threadlocal_mode";
457 let g = define_global "GVar05" fourty_two32 m ++
458 set_thread_local_mode ThreadLocalMode.InitialExec in
459 insist ((thread_local_mode g) = ThreadLocalMode.InitialExec);
460
461 (* CHECK: GVar06{{.*}}externally_initialized
462 *)
463 group "externally_initialized";
464 let g = define_global "GVar06" fourty_two32 m ++
465 set_externally_initialized true in
466 insist (is_externally_initialized g);
467
468 (* CHECK-NOWHERE-NOT: GVar07
455469 *)
456470 group "delete";
457 let g = define_global "GVar05" fourty_two32 m in
471 let g = define_global "GVar07" fourty_two32 m in
458472 delete_global g;
459473
460474 (* CHECK: ConstGlobalVar{{.*}}constant
10241038 insist ((metadata i kind) = None);
10251039
10261040 set_metadata i kind md
1041 end;
1042
1043 group "named metadata"; begin
1044 (* !md is emitted at EOF. *)
1045 let n1 = const_int i32_type 1 in
1046 let n2 = mdstring context "metadata test" in
1047 let md = mdnode context [| n1; n2 |] in
1048 add_named_metadata_operand m "md" md;
1049
1050 insist ((get_named_metadata m "md") = [| md |])
10271051 end;
10281052
10291053 group "dbg"; begin
12361260
12371261 (* CHECK: %build_alloca = alloca i32
12381262 * CHECK: %build_array_alloca = alloca i32, i32 %P2
1239 * CHECK: %build_load = load i32* %build_array_alloca
1240 * CHECK: store i32 %P2, i32* %build_alloca
1263 * CHECK: %build_load = load volatile i32* %build_array_alloca, align 4
1264 * CHECK: store volatile i32 %P2, i32* %build_alloca, align 4
12411265 * CHECK: %build_gep = getelementptr i32* %build_array_alloca, i32 %P2
12421266 * CHECK: %build_in_bounds_gep = getelementptr inbounds i32* %build_array_alloca, i32 %P2
12431267 * CHECK: %build_struct_gep = getelementptr inbounds{{.*}}%build_alloca2, i32 0, i32 1
1268 * CHECK: %build_atomicrmw = atomicrmw xchg i8* %p, i8 42 seq_cst
12441269 *)
12451270 let alloca = build_alloca i32_type "build_alloca" b in
12461271 let array_alloca = build_array_alloca i32_type p2 "build_array_alloca" b in
1247 ignore(build_load array_alloca "build_load" b);
1248 ignore(build_store p2 alloca b);
1272
1273 let load = build_load array_alloca "build_load" b in
1274 ignore(set_alignment 4 load);
1275 ignore(set_volatile true load);
1276 insist(true = is_volatile load);
1277 insist(4 = alignment load);
1278
1279 let store = build_store p2 alloca b in
1280 ignore(set_volatile true store);
1281 ignore(set_alignment 4 store);
1282 insist(true = is_volatile store);
1283 insist(4 = alignment store);
12491284 ignore(build_gep array_alloca [| p2 |] "build_gep" b);
12501285 ignore(build_in_bounds_gep array_alloca [| p2 |] "build_in_bounds_gep" b);
12511286
12521287 let sty = struct_type context [| i32_type; i8_type |] in
12531288 let alloca2 = build_alloca sty "build_alloca2" b in
12541289 ignore(build_struct_gep alloca2 1 "build_struct_gep" b);
1290
1291 let p = build_alloca i8_type "p" b in
1292 ignore(build_atomicrmw AtomicRMWBinOp.Xchg p (const_int i8_type 42)
1293 AtomicOrdering.SequentiallyConsistent false "build_atomicrmw"
1294 b);
12551295
12561296 ignore(build_unreachable b)
12571297 end;
12911331
12921332 (* End-of-file checks for things like metdata and attributes.
12931333 * CHECK: attributes #0 = {{.*}}uwtable{{.*}}
1334 * CHECK: !md = !{!0}
12941335 * CHECK: !0 = metadata !{i32 1, metadata !"metadata test"}
12951336 * CHECK: !1 = metadata !{i32 2, i32 3, metadata !2, metadata !2}
12961337 *)