llvm.org GIT mirror llvm / b02b878
Convert the rest of the ocaml types and functions to use context. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@79430 91177308-0d34-0410-b5e6-96231b3b80d8 Erick Tryzelaar 11 years ago
10 changed file(s) with 244 addition(s) and 191 deletion(s). Raw diff Collapse all Expand all
154154 external type_context : lltype -> llcontext = "llvm_type_context"
155155
156156 (*--... Operations on integer types ........................................--*)
157 external _i1_type : unit -> lltype = "llvm_i1_type"
158 external _i8_type : unit -> lltype = "llvm_i8_type"
159 external _i16_type : unit -> lltype = "llvm_i16_type"
160 external _i32_type : unit -> lltype = "llvm_i32_type"
161 external _i64_type : unit -> lltype = "llvm_i64_type"
162
163 let i1_type = _i1_type ()
164 let i8_type = _i8_type ()
165 let i16_type = _i16_type ()
166 let i32_type = _i32_type ()
167 let i64_type = _i64_type ()
168
169 external integer_type : int -> lltype = "llvm_integer_type"
157 external i1_type : llcontext -> lltype = "llvm_i1_type"
158 external i8_type : llcontext -> lltype = "llvm_i8_type"
159 external i16_type : llcontext -> lltype = "llvm_i16_type"
160 external i32_type : llcontext -> lltype = "llvm_i32_type"
161 external i64_type : llcontext -> lltype = "llvm_i64_type"
162
163 external integer_type : llcontext -> int -> lltype = "llvm_integer_type"
170164 external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth"
171165
172166 (*--... Operations on real types ...........................................--*)
173 external _float_type : unit -> lltype = "llvm_float_type"
174 external _double_type : unit -> lltype = "llvm_double_type"
175 external _x86fp80_type : unit -> lltype = "llvm_x86fp80_type"
176 external _fp128_type : unit -> lltype = "llvm_fp128_type"
177 external _ppc_fp128_type : unit -> lltype = "llvm_ppc_fp128_type"
178
179 let float_type = _float_type ()
180 let double_type = _double_type ()
181 let x86fp80_type = _x86fp80_type ()
182 let fp128_type = _fp128_type ()
183 let ppc_fp128_type = _ppc_fp128_type ()
167 external float_type : llcontext -> lltype = "llvm_float_type"
168 external double_type : llcontext -> lltype = "llvm_double_type"
169 external x86fp80_type : llcontext -> lltype = "llvm_x86fp80_type"
170 external fp128_type : llcontext -> lltype = "llvm_fp128_type"
171 external ppc_fp128_type : llcontext -> lltype = "llvm_ppc_fp128_type"
184172
185173 (*--... Operations on function types .......................................--*)
186174 external function_type : lltype -> lltype array -> lltype = "llvm_function_type"
210198 external vector_size : lltype -> int = "llvm_vector_size"
211199
212200 (*--... Operations on other types ..........................................--*)
213 external opaque_type : unit -> lltype = "llvm_opaque_type"
214 external _void_type : unit -> lltype = "llvm_void_type"
215 external _label_type : unit -> lltype = "llvm_label_type"
216
217 let void_type = _void_type ()
218 let label_type = _label_type ()
201 external opaque_type : llcontext -> lltype = "llvm_opaque_type"
202 external void_type : llcontext -> lltype = "llvm_void_type"
203 external label_type : llcontext -> lltype = "llvm_label_type"
219204
220205 (*--... Operations on type handles .........................................--*)
221206 external handle_to_type : lltype -> lltypehandle = "llvm_handle_to_type"
248233 = "llvm_const_float_of_string"
249234
250235 (*--... Operations on composite constants ..................................--*)
251 external const_string : string -> llvalue = "llvm_const_string"
252 external const_stringz : string -> llvalue = "llvm_const_stringz"
236 external const_string : llcontext -> string -> llvalue = "llvm_const_string"
237 external const_stringz : llcontext -> string -> llvalue = "llvm_const_stringz"
253238 external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array"
254239 external const_struct : llcontext -> llvalue array -> llvalue
255240 = "llvm_const_struct"
534519 external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks"
535520 external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock"
536521 external delete_block : llbasicblock -> unit = "llvm_delete_block"
537 external append_block : string -> llvalue -> llbasicblock = "llvm_append_block"
538 external insert_block : string -> llbasicblock -> llbasicblock
522 external append_block : llcontext -> string -> llvalue -> llbasicblock
523 = "llvm_append_block"
524 external insert_block : llcontext -> string -> llbasicblock -> llbasicblock
539525 = "llvm_insert_block"
540526 external block_begin : llvalue -> (llvalue, llbasicblock) llpos
541527 = "llvm_block_begin"
272272
273273 (** {7 Operations on integer types} *)
274274
275 (** The 1-bit integer type. See [llvm::Type::Int1Ty]. *)
276 val i1_type : lltype
277
278 (** The 8-bit integer type. See [llvm::Type::Int8Ty]. *)
279 val i8_type : lltype
280
281 (** The 16-bit integer type. See [llvm::Type::Int16Ty]. *)
282 val i16_type : lltype
283
284 (** The 32-bit integer type. See [llvm::Type::Int32Ty]. *)
285 val i32_type : lltype
286
287 (** The 64-bit integer type. See [llvm::Type::Int64Ty]. *)
288 val i64_type : lltype
289
290 (** [integer_type n] returns an integer type of bitwidth [n].
291 See the method [llvm::IntegerType::get]. *)
292 external integer_type : int -> lltype = "llvm_integer_type"
293
294 (** [integer_bitwidth ty] returns the number of bits in the integer type [ty].
295 See the method [llvm::IntegerType::getBitWidth]. *)
275 (** [i1_type c] returns an integer type of bitwidth 1 in the context [c]. See
276 [llvm::Type::Int1Ty]. *)
277 external i1_type : llcontext -> lltype = "llvm_i1_type"
278
279 (** [i8_type c] returns an integer type of bitwidth 8 in the context [c]. See
280 [llvm::Type::Int8Ty]. *)
281 external i8_type : llcontext -> lltype = "llvm_i8_type"
282
283 (** [i16_type c] returns an integer type of bitwidth 16 in the context [c]. See
284 [llvm::Type::Int16Ty]. *)
285 external i16_type : llcontext -> lltype = "llvm_i16_type"
286
287 (** [i32_type c] returns an integer type of bitwidth 32 in the context [c]. See
288 [llvm::Type::Int32Ty]. *)
289 external i32_type : llcontext -> lltype = "llvm_i32_type"
290
291 (** [i64_type c] returns an integer type of bitwidth 64 in the context [c]. See
292 [llvm::Type::Int64Ty]. *)
293 external i64_type : llcontext -> lltype = "llvm_i64_type"
294
295 (** [integer_type c n] returns an integer type of bitwidth [n] in the context
296 [c]. See the method [llvm::IntegerType::get]. *)
297 external integer_type : llcontext -> int -> lltype = "llvm_integer_type"
298
299 (** [integer_bitwidth c ty] returns the number of bits in the integer type [ty]
300 in the context [c]. See the method [llvm::IntegerType::getBitWidth]. *)
296301 external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth"
297302
298303
299304 (** {7 Operations on real types} *)
300305
301 (** The IEEE 32-bit floating point type. See [llvm::Type::FloatTy]. *)
302 val float_type : lltype
303
304 (** The IEEE 64-bit floating point type. See [llvm::Type::DoubleTy]. *)
305 val double_type : lltype
306
307 (** The x87 80-bit floating point type. See [llvm::Type::X86_FP80Ty]. *)
308 val x86fp80_type : lltype
309
310 (** The IEEE 128-bit floating point type. See [llvm::Type::FP128Ty]. *)
311 val fp128_type : lltype
312
313 (** The PowerPC 128-bit floating point type. See [llvm::Type::PPC_FP128Ty]. *)
314 val ppc_fp128_type : lltype
306 (** [float_type c] returns the IEEE 32-bit floating point type in the context
307 [c]. See [llvm::Type::FloatTy]. *)
308 external float_type : llcontext -> lltype = "llvm_float_type"
309
310 (** [double_type c] returns the IEEE 64-bit floating point type in the context
311 [c]. See [llvm::Type::DoubleTy]. *)
312 external double_type : llcontext -> lltype = "llvm_double_type"
313
314 (** [x86fp80_type c] returns the x87 80-bit floating point type in the context
315 [c]. See [llvm::Type::X86_FP80Ty]. *)
316 external x86fp80_type : llcontext -> lltype = "llvm_x86fp80_type"
317
318 (** [fp128_type c] returns the IEEE 128-bit floating point type in the context
319 [c]. See [llvm::Type::FP128Ty]. *)
320 external fp128_type : llcontext -> lltype = "llvm_fp128_type"
321
322 (** [ppc_fp128_type c] returns the PowerPC 128-bit floating point type in the
323 context [c]. See [llvm::Type::PPC_FP128Ty]. *)
324 external ppc_fp128_type : llcontext -> lltype = "llvm_ppc_fp128_type"
315325
316326
317327 (** {7 Operations on function types} *)
404414
405415 (** {7 Operations on other types} *)
406416
407 (** [opaque_type ()] creates a new opaque type distinct from any other.
408 Opaque types are useful for building recursive types in combination with
409 {!refine_type}.
410 See [llvm::OpaqueType::get]. *)
411 external opaque_type : unit -> lltype = "llvm_opaque_type"
412
413 (** [void_type] is the type of a function which does not return any value.
414 See [llvm::Type::VoidTy]. *)
415 val void_type : lltype
416
417 (** [label_type] is the type of a basic block. See [llvm::Type::LabelTy]. *)
418 val label_type : lltype
417 (** [opaque_type c] creates a new opaque type distinct from any other in the
418 context [c]. Opaque types are useful for building recursive types in
419 combination with {!refine_type}. See [llvm::OpaqueType::get]. *)
420 external opaque_type : llcontext -> lltype = "llvm_opaque_type"
421
422 (** [void_type c] creates a type of a function which does not return any
423 value in the context [c]. See [llvm::Type::VoidTy]. *)
424 external void_type : llcontext -> lltype = "llvm_void_type"
425
426 (** [label_type c] creates a type of a basic block in the context [c]. See
427 [llvm::Type::LabelTy]. *)
428 external label_type : llcontext -> lltype = "llvm_label_type"
419429
420430 (** {7 Operations on type handles} *)
421431
512522
513523 (** {7 Operations on composite constants} *)
514524
515 (** [const_string s] returns the constant [i8] array with the values of the
516 characters in the string [s]. The array is not null-terminated (but see
517 {!const_stringz}). This value can in turn be used as the initializer for a
518 global variable. See the method [llvm::ConstantArray::get]. *)
519 external const_string : string -> llvalue = "llvm_const_string"
520
521 (** [const_stringz s] returns the constant [i8] array with the values of the
522 characters in the string [s] and a null terminator. This value can in turn
523 be used as the initializer for a global variable.
525 (** [const_string c s] returns the constant [i8] array with the values of the
526 characters in the string [s] in the context [c]. The array is not
527 null-terminated (but see {!const_stringz}). This value can in turn be used
528 as the initializer for a global variable. See the method
529 [llvm::ConstantArray::get]. *)
530 external const_string : llcontext -> string -> llvalue = "llvm_const_string"
531
532 (** [const_stringz c s] returns the constant [i8] array with the values of the
533 characters in the string [s] and a null terminator in the context [c]. This
534 value can in turn be used as the initializer for a global variable.
524535 See the method [llvm::ConstantArray::get]. *)
525 external const_stringz : string -> llvalue = "llvm_const_stringz"
536 external const_stringz : llcontext -> string -> llvalue = "llvm_const_stringz"
526537
527538 (** [const_array ty elts] returns the constant array of type
528539 [array_type ty (Array.length elts)] and containing the values [elts].
11581169 See the method [llvm::BasicBlock::eraseFromParent]. *)
11591170 external delete_block : llbasicblock -> unit = "llvm_delete_block"
11601171
1161 (** [append_block name f] creates a new basic block named [name] at the end of
1162 function [f].
1172 (** [append_block c name f] creates a new basic block named [name] at the end of
1173 function [f] in the context [c].
11631174 See the constructor of [llvm::BasicBlock]. *)
1164 external append_block : string -> llvalue -> llbasicblock = "llvm_append_block"
1165
1166 (** [insert_block name bb] creates a new basic block named [name] before the
1167 basic block [bb].
1175 external append_block : llcontext -> string -> llvalue -> llbasicblock
1176 = "llvm_append_block"
1177
1178 (** [insert_block c name bb] creates a new basic block named [name] before the
1179 basic block [bb] in the context [c].
11681180 See the constructor of [llvm::BasicBlock]. *)
1169 external insert_block : string -> llbasicblock -> llbasicblock
1181 external insert_block : llcontext -> string -> llbasicblock -> llbasicblock
11701182 = "llvm_insert_block"
11711183
11721184 (** [block_parent bb] returns the parent function that owns the basic block.
177177
178178 /*--... Operations on integer types ........................................--*/
179179
180 /* unit -> lltype */
181 CAMLprim LLVMTypeRef llvm_i1_type (value Unit) { return LLVMInt1Type(); }
182 CAMLprim LLVMTypeRef llvm_i8_type (value Unit) { return LLVMInt8Type(); }
183 CAMLprim LLVMTypeRef llvm_i16_type(value Unit) { return LLVMInt16Type(); }
184 CAMLprim LLVMTypeRef llvm_i32_type(value Unit) { return LLVMInt32Type(); }
185 CAMLprim LLVMTypeRef llvm_i64_type(value Unit) { return LLVMInt64Type(); }
186
187 /* int -> lltype */
188 CAMLprim LLVMTypeRef llvm_integer_type(value Width) {
189 return LLVMIntType(Int_val(Width));
180 /* llcontext -> lltype */
181 CAMLprim LLVMTypeRef llvm_i1_type (LLVMContextRef Context) {
182 return LLVMInt1TypeInContext(Context);
183 }
184
185 /* llcontext -> lltype */
186 CAMLprim LLVMTypeRef llvm_i8_type (LLVMContextRef Context) {
187 return LLVMInt8TypeInContext(Context);
188 }
189
190 /* llcontext -> lltype */
191 CAMLprim LLVMTypeRef llvm_i16_type (LLVMContextRef Context) {
192 return LLVMInt16TypeInContext(Context);
193 }
194
195 /* llcontext -> lltype */
196 CAMLprim LLVMTypeRef llvm_i32_type (LLVMContextRef Context) {
197 return LLVMInt32TypeInContext(Context);
198 }
199
200 /* llcontext -> lltype */
201 CAMLprim LLVMTypeRef llvm_i64_type (LLVMContextRef Context) {
202 return LLVMInt64TypeInContext(Context);
203 }
204
205 /* llcontext -> int -> lltype */
206 CAMLprim LLVMTypeRef llvm_integer_type(LLVMContextRef Context, value Width) {
207 return LLVMIntTypeInContext(Context, Int_val(Width));
190208 }
191209
192210 /* lltype -> int */
196214
197215 /*--... Operations on real types ...........................................--*/
198216
199 /* unit -> lltype */
200 CAMLprim LLVMTypeRef llvm_float_type(value Unit) {
201 return LLVMFloatType();
202 }
203
204 /* unit -> lltype */
205 CAMLprim LLVMTypeRef llvm_double_type(value Unit) {
206 return LLVMDoubleType();
207 }
208
209 /* unit -> lltype */
210 CAMLprim LLVMTypeRef llvm_x86fp80_type(value Unit) {
211 return LLVMX86FP80Type();
212 }
213
214 /* unit -> lltype */
215 CAMLprim LLVMTypeRef llvm_fp128_type(value Unit) {
216 return LLVMFP128Type();
217 }
218
219 /* unit -> lltype */
220 CAMLprim LLVMTypeRef llvm_ppc_fp128_type(value Unit) {
221 return LLVMPPCFP128Type();
217 /* llcontext -> lltype */
218 CAMLprim LLVMTypeRef llvm_float_type(LLVMContextRef Context) {
219 return LLVMFloatTypeInContext(Context);
220 }
221
222 /* llcontext -> lltype */
223 CAMLprim LLVMTypeRef llvm_double_type(LLVMContextRef Context) {
224 return LLVMDoubleTypeInContext(Context);
225 }
226
227 /* llcontext -> lltype */
228 CAMLprim LLVMTypeRef llvm_x86fp80_type(LLVMContextRef Context) {
229 return LLVMX86FP80TypeInContext(Context);
230 }
231
232 /* llcontext -> lltype */
233 CAMLprim LLVMTypeRef llvm_fp128_type(LLVMContextRef Context) {
234 return LLVMFP128TypeInContext(Context);
235 }
236
237 /* llcontext -> lltype */
238 CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) {
239 return LLVMPPCFP128TypeInContext(Context);
222240 }
223241
224242 /*--... Operations on function types .......................................--*/
315333
316334 /*--... Operations on other types ..........................................--*/
317335
318 /* unit -> lltype */
319 CAMLprim LLVMTypeRef llvm_void_type (value Unit) { return LLVMVoidType(); }
320 CAMLprim LLVMTypeRef llvm_label_type(value Unit) { return LLVMLabelType(); }
321
322 /* unit -> lltype */
323 CAMLprim LLVMTypeRef llvm_opaque_type(value Unit) {
324 return LLVMOpaqueType();
336 /* llcontext -> lltype */
337 CAMLprim LLVMTypeRef llvm_void_type (LLVMContextRef Context) {
338 return LLVMVoidTypeInContext(Context);
339 }
340
341 /* llcontext -> lltype */
342 CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
343 return LLVMLabelTypeInContext(Context);
344 }
345
346 /* llcontext -> lltype */
347 CAMLprim LLVMTypeRef llvm_opaque_type(LLVMContextRef Context) {
348 return LLVMOpaqueTypeInContext(Context);
325349 }
326350
327351 /*--... Operations on type handles .........................................--*/
431455
432456 /*--... Operations on composite constants ..................................--*/
433457
434 /* string -> llvalue */
435 CAMLprim LLVMValueRef llvm_const_string(value Str, value NullTerminate) {
436 return LLVMConstString(String_val(Str), string_length(Str), 1);
437 }
438
439 /* string -> llvalue */
440 CAMLprim LLVMValueRef llvm_const_stringz(value Str, value NullTerminate) {
441 return LLVMConstString(String_val(Str), string_length(Str), 0);
458 /* llcontext -> string -> llvalue */
459 CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str,
460 value NullTerminate) {
461 return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
462 1);
463 }
464
465 /* llcontext -> string -> llvalue */
466 CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str,
467 value NullTerminate) {
468 return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
469 0);
442470 }
443471
444472 /* lltype -> llvalue array -> llvalue */
696724 CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
697725 LLVMModuleRef M) {
698726 LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
699 LLVMAppendBasicBlock(Fn, "entry");
727 LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry");
700728 return Fn;
701729 }
702730
809837 }
810838
811839 /* string -> llvalue -> llbasicblock */
812 CAMLprim LLVMBasicBlockRef llvm_append_block(value Name, LLVMValueRef Fn) {
813 return LLVMAppendBasicBlock(Fn, String_val(Name));
840 CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
841 LLVMValueRef Fn) {
842 return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name));
814843 }
815844
816845 /* string -> llbasicblock -> llbasicblock */
817 CAMLprim LLVMBasicBlockRef llvm_insert_block(value Name, LLVMBasicBlockRef BB) {
818 return LLVMInsertBasicBlock(BB, String_val(Name));
846 CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name,
847 LLVMBasicBlockRef BB) {
848 return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name));
819849 }
820850
821851 /* llvalue -> bool */
77 (* Note that this takes a moment to link, so it's best to keep the number of
88 individual tests low. *)
99
10 let context = global_context ()
11
1012 let test x = if not x then exit 1 else ()
1113
1214 let bomb msg =
1416 exit 2
1517
1618 let _ =
17 let fty = function_type void_type [| |] in
18 let m = create_module (global_context ()) "valid_m" in
19 let fty = function_type (void_type context) [| |] in
20 let m = create_module context "valid_m" in
1921 let fn = define_function "valid_fn" fty m in
20 let at_entry = builder_at_end (global_context ()) (entry_block fn) in
22 let at_entry = builder_at_end context (entry_block fn) in
2123 ignore (build_ret_void at_entry);
2224
2325
1313 let fn = Sys.argv.(1) in
1414 let m = Llvm.create_module context "ocaml_test_module" in
1515
16 ignore (Llvm.define_type_name "caml_int_ty" Llvm.i32_type m);
16 ignore (Llvm.define_type_name "caml_int_ty" (Llvm.i32_type context) m);
1717
1818 test (Llvm_bitwriter.write_bitcode_file m fn);
1919
55 (* Note that this takes a moment to link, so it's best to keep the number of
66 individual tests low. *)
77
8 let context = Llvm.global_context ()
9
810 let test x = if not x then exit 1 else ()
911
1012 let _ =
11 let m = Llvm.create_module (Llvm.global_context ()) "ocaml_test_module" in
13 let m = Llvm.create_module context "ocaml_test_module" in
1214
13 ignore (Llvm.define_type_name "caml_int_ty" Llvm.i32_type m);
15 ignore (Llvm.define_type_name "caml_int_ty" (Llvm.i32_type context) m);
1416
1517 test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1))
77
88 (* Note that this takes a moment to link, so it's best to keep the number of
99 individual tests low. *)
10
11 let context = global_context ()
12 let i8_type = Llvm.i8_type context
13 let i32_type = Llvm.i32_type context
14 let i64_type = Llvm.i64_type context
15 let double_type = Llvm.double_type context
1016
1117 let bomb msg =
1218 prerr_endline msg;
88 open Llvm_scalar_opts
99 open Llvm_target
1010
11 let context = global_context ()
12 let void_type = Llvm.void_type context
1113
1214 (* Tiny unit test framework - really just to help find which line is busted *)
1315 let suite name f =
1820 (*===-- Fixture -----------------------------------------------------------===*)
1921
2022 let filename = Sys.argv.(1)
21 let m = create_module (global_context ()) filename
23 let m = create_module context filename
2224 let mp = ModuleProvider.create m
2325
2426
2931
3032 let fty = function_type void_type [| |] in
3133 let fn = define_function "fn" fty m in
32 ignore (build_ret_void (builder_at_end (global_context ()) (entry_block fn)));
34 ignore (build_ret_void (builder_at_end context (entry_block fn)));
3335
3436 let td = TargetData.create (target_triple m) in
3537
77 open Llvm
88 open Llvm_target
99
10 let context = global_context ()
11 let i32_type = Llvm.i32_type context
12 let i64_type = Llvm.i64_type context
13
1014 (* Tiny unit test framework - really just to help find which line is busted *)
1115 let suite name f =
1216 prerr_endline (name ^ ":");
1620 (*===-- Fixture -----------------------------------------------------------===*)
1721
1822 let filename = Sys.argv.(1)
19 let m = create_module (global_context ()) filename
23 let m = create_module context filename
2024
2125
2226 (*===-- Target Data -------------------------------------------------------===*)
2327
2428 let test_target_data () =
2529 let td = TargetData.create (target_triple m) in
26 let sty = struct_type (global_context ()) [| i32_type; i64_type |] in
30 let sty = struct_type context [| i32_type; i64_type |] in
2731
2832 ignore (TargetData.as_string td);
2933 ignore (TargetData.invalidate_struct_layout td sty);
1717 let case_num = ref 0
1818 let print_checkpoints = false
1919 let context = global_context ()
20 let i1_type = Llvm.i1_type context
21 let i8_type = Llvm.i8_type context
22 let i16_type = Llvm.i16_type context
23 let i32_type = Llvm.i32_type context
24 let i64_type = Llvm.i64_type context
25 let void_type = Llvm.void_type context
26 let float_type = Llvm.float_type context
27 let double_type = Llvm.double_type context
28 let fp128_type = Llvm.fp128_type context
2029
2130 let group name =
2231 group_name := !suite_name ^ "/" ^ name;
93102 (* RUN: grep {Ty04.*i42} < %t.ll
94103 *)
95104 group "i42";
96 let ty = integer_type 42 in
105 let ty = integer_type context 42 in
97106 insist (define_type_name "Ty04" ty m);
98107
99108 (* RUN: grep {Ty05.*float} < %t.ll
164173 (* RUN: grep {Ty12.*opaque} < %t.ll
165174 *)
166175 group "opaque";
167 let ty = opaque_type () in
176 let ty = opaque_type context in
168177 insist (define_type_name "Ty12" ty m);
169178 insist (ty == ty);
170 insist (ty <> opaque_type ());
179 insist (ty <> opaque_type context);
171180
172181 (* RUN: grep -v {Ty13} < %t.ll
173182 *)
174183 group "delete";
175 let ty = opaque_type () in
184 let ty = opaque_type context in
176185 insist (define_type_name "Ty13" ty m);
177186 delete_type_name "Ty13" m;
178187
179188 (* RUN: grep -v {RecursiveTy.*RecursiveTy} < %t.ll
180189 *)
181190 group "recursive";
182 let ty = opaque_type () in
191 let ty = opaque_type context in
183192 let th = handle_to_type ty in
184193 refine_type ty (pointer_type ty);
185194 let ty = type_of_handle th in
222231 (* RUN: grep {Const04.*"cruel\\\\00world"} < %t.ll
223232 *)
224233 group "string";
225 let c = const_string "cruel\000world" in
234 let c = const_string context "cruel\000world" in
226235 ignore (define_global "Const04" c m);
227236 insist ((array_type i8_type 11) = type_of c);
228237
229238 (* RUN: grep {Const05.*"hi\\\\00again\\\\00"} < %t.ll
230239 *)
231240 group "stringz";
232 let c = const_stringz "hi\000again" in
241 let c = const_stringz context "hi\000again" in
233242 ignore (define_global "Const05" c m);
234243 insist ((array_type i8_type 9) = type_of c);
235244
355364 * RUN: grep {ConstIntToPtr.*inttoptr} < %t.ll
356365 * RUN: grep {ConstBitCast.*bitcast} < %t.ll
357366 *)
358 let i128_type = integer_type 128 in
367 let i128_type = integer_type context 128 in
359368 ignore (define_global "ConstTrunc" (const_trunc (const_add foldbomb five)
360369 i8_type) m);
361370 ignore (define_global "ConstSExt" (const_sext foldbomb i128_type) m);
672681 *)
673682 group "entry";
674683 let fn = declare_function "X" ty m in
675 let bb = append_block "Bb1" fn in
684 let bb = append_block context "Bb1" fn in
676685 insist (bb = entry_block fn);
677686 ignore (build_unreachable (builder_at_end context bb));
678687
680689 *)
681690 group "delete";
682691 let fn = declare_function "X2" ty m in
683 let bb = append_block "Bb2" fn in
692 let bb = append_block context "Bb2" fn in
684693 delete_block bb;
685694
686695 group "insert";
687696 let fn = declare_function "X3" ty m in
688 let bbb = append_block "b" fn in
689 let bba = insert_block "a" bbb in
697 let bbb = append_block context "b" fn in
698 let bba = insert_block context "a" bbb in
690699 insist ([| bba; bbb |] = basic_blocks fn);
691700 ignore (build_unreachable (builder_at_end context bba));
692701 ignore (build_unreachable (builder_at_end context bbb));
716725 insist (At_end f = block_begin f);
717726 insist (At_start f = block_end f);
718727
719 let b1 = append_block "One" f in
720 let b2 = append_block "Two" f in
728 let b1 = append_block context "One" f in
729 let b2 = append_block context "Two" f in
721730
722731 insist (Before b1 = block_begin f);
723732 insist (Before b2 = block_succ b1);
803812 *)
804813 let fty = function_type void_type [| |] in
805814 let fn = declare_function "X6" fty m in
806 let b = builder_at_end context (append_block "Bb01" fn) in
815 let b = builder_at_end context (append_block context "Bb01" fn) in
807816 ignore (build_ret_void b)
808817 end;
809818
816825 let f1 = build_uitofp p1 float_type "F1" atentry in
817826 let f2 = build_uitofp p2 float_type "F2" atentry in
818827
819 let bb00 = append_block "Bb00" fn in
828 let bb00 = append_block context "Bb00" fn in
820829 ignore (build_unreachable (builder_at_end context bb00));
821830
822831 group "ret"; begin
829838 group "br"; begin
830839 (* RUN: grep {br.*Bb02} < %t.ll
831840 *)
832 let bb02 = append_block "Bb02" fn in
841 let bb02 = append_block context "Bb02" fn in
833842 let b = builder_at_end context bb02 in
834843 ignore (build_br bb02 b)
835844 end;
837846 group "cond_br"; begin
838847 (* RUN: grep {br.*Inst01.*Bb03.*Bb00} < %t.ll
839848 *)
840 let bb03 = append_block "Bb03" fn in
849 let bb03 = append_block context "Bb03" fn in
841850 let b = builder_at_end context bb03 in
842851 let cond = build_trunc p1 i1_type "Inst01" b in
843852 ignore (build_cond_br cond bb03 bb00 b)
847856 (* RUN: grep {switch.*P1.*SwiBlock3} < %t.ll
848857 * RUN: grep {2,.*SwiBlock2} < %t.ll
849858 *)
850 let bb1 = append_block "SwiBlock1" fn in
851 let bb2 = append_block "SwiBlock2" fn in
859 let bb1 = append_block context "SwiBlock1" fn in
860 let bb2 = append_block context "SwiBlock2" fn in
852861 ignore (build_unreachable (builder_at_end context bb2));
853 let bb3 = append_block "SwiBlock3" fn in
862 let bb3 = append_block context "SwiBlock3" fn in
854863 ignore (build_unreachable (builder_at_end context bb3));
855864 let si = build_switch p1 bb3 1 (builder_at_end context bb1) in
856865 ignore (add_case si (const_int i32_type 2) bb2)
860869 (* RUN: grep {Inst02.*invoke.*P1.*P2} < %t.ll
861870 * RUN: grep {to.*Bb04.*unwind.*Bb00} < %t.ll
862871 *)
863 let bb04 = append_block "Bb04" fn in
872 let bb04 = append_block context "Bb04" fn in
864873 let b = builder_at_end context bb04 in
865874 ignore (build_invoke fn [| p1; p2 |] bb04 bb00 "Inst02" b)
866875 end;
868877 group "unwind"; begin
869878 (* RUN: grep {unwind} < %t.ll
870879 *)
871 let bb05 = append_block "Bb05" fn in
880 let bb05 = append_block context "Bb05" fn in
872881 let b = builder_at_end context bb05 in
873882 ignore (build_unwind b)
874883 end;
876885 group "unreachable"; begin
877886 (* RUN: grep {unreachable} < %t.ll
878887 *)
879 let bb06 = append_block "Bb06" fn in
888 let bb06 = append_block context "Bb06" fn in
880889 let b = builder_at_end context bb06 in
881890 ignore (build_unreachable b)
882891 end;
883892
884893 group "arithmetic"; begin
885 let bb07 = append_block "Bb07" fn in
894 let bb07 = append_block context "Bb07" fn in
886895 let b = builder_at_end context bb07 in
887896
888897 (* RUN: grep {Inst03.*add.*P1.*P2} < %t.ll
924933 end;
925934
926935 group "memory"; begin
927 let bb08 = append_block "Bb08" fn in
936 let bb08 = append_block context "Bb08" fn in
928937 let b = builder_at_end context bb08 in
929938
930939 (* RUN: grep {Inst20.*malloc.*i8 } < %t.ll
10331042 group "phi"; begin
10341043 (* RUN: grep {PhiNode.*P1.*PhiBlock1.*P2.*PhiBlock2} < %t.ll
10351044 *)
1036 let b1 = append_block "PhiBlock1" fn in
1037 let b2 = append_block "PhiBlock2" fn in
1038
1039 let jb = append_block "PhiJoinBlock" fn in
1045 let b1 = append_block context "PhiBlock1" fn in
1046 let b2 = append_block context "PhiBlock2" fn in
1047
1048 let jb = append_block context "PhiJoinBlock" fn in
10401049 ignore (build_br jb (builder_at_end context b1));
10411050 ignore (build_br jb (builder_at_end context b2));
10421051 let at_jb = builder_at_end context jb in