From: Erick Tryzelaar Date: Wed, 19 Aug 2009 17:32:24 +0000 (+0000) Subject: Convert the rest of the ocaml types and functions to use context. X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=commitdiff_plain;h=b02b87882788e57e180c6b903a37ced0db1ce828 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 --- diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 74fd1f1e170..25707027b09 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -155,33 +155,21 @@ external classify_type : lltype -> TypeKind.t = "llvm_classify_type" external type_context : lltype -> llcontext = "llvm_type_context" (*--... Operations on integer types ........................................--*) -external _i1_type : unit -> lltype = "llvm_i1_type" -external _i8_type : unit -> lltype = "llvm_i8_type" -external _i16_type : unit -> lltype = "llvm_i16_type" -external _i32_type : unit -> lltype = "llvm_i32_type" -external _i64_type : unit -> lltype = "llvm_i64_type" - -let i1_type = _i1_type () -let i8_type = _i8_type () -let i16_type = _i16_type () -let i32_type = _i32_type () -let i64_type = _i64_type () - -external integer_type : int -> lltype = "llvm_integer_type" +external i1_type : llcontext -> lltype = "llvm_i1_type" +external i8_type : llcontext -> lltype = "llvm_i8_type" +external i16_type : llcontext -> lltype = "llvm_i16_type" +external i32_type : llcontext -> lltype = "llvm_i32_type" +external i64_type : llcontext -> lltype = "llvm_i64_type" + +external integer_type : llcontext -> int -> lltype = "llvm_integer_type" external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth" (*--... Operations on real types ...........................................--*) -external _float_type : unit -> lltype = "llvm_float_type" -external _double_type : unit -> lltype = "llvm_double_type" -external _x86fp80_type : unit -> lltype = "llvm_x86fp80_type" -external _fp128_type : unit -> lltype = "llvm_fp128_type" -external _ppc_fp128_type : unit -> lltype = "llvm_ppc_fp128_type" - -let float_type = _float_type () -let double_type = _double_type () -let x86fp80_type = _x86fp80_type () -let fp128_type = _fp128_type () -let ppc_fp128_type = _ppc_fp128_type () +external float_type : llcontext -> lltype = "llvm_float_type" +external double_type : llcontext -> lltype = "llvm_double_type" +external x86fp80_type : llcontext -> lltype = "llvm_x86fp80_type" +external fp128_type : llcontext -> lltype = "llvm_fp128_type" +external ppc_fp128_type : llcontext -> lltype = "llvm_ppc_fp128_type" (*--... Operations on function types .......................................--*) external function_type : lltype -> lltype array -> lltype = "llvm_function_type" @@ -211,12 +199,9 @@ external address_space : lltype -> int = "llvm_address_space" external vector_size : lltype -> int = "llvm_vector_size" (*--... Operations on other types ..........................................--*) -external opaque_type : unit -> lltype = "llvm_opaque_type" -external _void_type : unit -> lltype = "llvm_void_type" -external _label_type : unit -> lltype = "llvm_label_type" - -let void_type = _void_type () -let label_type = _label_type () +external opaque_type : llcontext -> lltype = "llvm_opaque_type" +external void_type : llcontext -> lltype = "llvm_void_type" +external label_type : llcontext -> lltype = "llvm_label_type" (*--... Operations on type handles .........................................--*) external handle_to_type : lltype -> lltypehandle = "llvm_handle_to_type" @@ -249,8 +234,8 @@ external const_float_of_string : lltype -> string -> llvalue = "llvm_const_float_of_string" (*--... Operations on composite constants ..................................--*) -external const_string : string -> llvalue = "llvm_const_string" -external const_stringz : string -> llvalue = "llvm_const_stringz" +external const_string : llcontext -> string -> llvalue = "llvm_const_string" +external const_stringz : llcontext -> string -> llvalue = "llvm_const_stringz" external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array" external const_struct : llcontext -> llvalue array -> llvalue = "llvm_const_struct" @@ -535,8 +520,9 @@ external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent" external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks" external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock" external delete_block : llbasicblock -> unit = "llvm_delete_block" -external append_block : string -> llvalue -> llbasicblock = "llvm_append_block" -external insert_block : string -> llbasicblock -> llbasicblock +external append_block : llcontext -> string -> llvalue -> llbasicblock + = "llvm_append_block" +external insert_block : llcontext -> string -> llbasicblock -> llbasicblock = "llvm_insert_block" external block_begin : llvalue -> (llvalue, llbasicblock) llpos = "llvm_block_begin" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 1eaa7fa18a5..789a9752011 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -273,46 +273,56 @@ val string_of_lltype : lltype -> string (** {7 Operations on integer types} *) -(** The 1-bit integer type. See [llvm::Type::Int1Ty]. *) -val i1_type : lltype +(** [i1_type c] returns an integer type of bitwidth 1 in the context [c]. See + [llvm::Type::Int1Ty]. *) +external i1_type : llcontext -> lltype = "llvm_i1_type" -(** The 8-bit integer type. See [llvm::Type::Int8Ty]. *) -val i8_type : lltype +(** [i8_type c] returns an integer type of bitwidth 8 in the context [c]. See + [llvm::Type::Int8Ty]. *) +external i8_type : llcontext -> lltype = "llvm_i8_type" -(** The 16-bit integer type. See [llvm::Type::Int16Ty]. *) -val i16_type : lltype +(** [i16_type c] returns an integer type of bitwidth 16 in the context [c]. See + [llvm::Type::Int16Ty]. *) +external i16_type : llcontext -> lltype = "llvm_i16_type" -(** The 32-bit integer type. See [llvm::Type::Int32Ty]. *) -val i32_type : lltype +(** [i32_type c] returns an integer type of bitwidth 32 in the context [c]. See + [llvm::Type::Int32Ty]. *) +external i32_type : llcontext -> lltype = "llvm_i32_type" -(** The 64-bit integer type. See [llvm::Type::Int64Ty]. *) -val i64_type : lltype +(** [i64_type c] returns an integer type of bitwidth 64 in the context [c]. See + [llvm::Type::Int64Ty]. *) +external i64_type : llcontext -> lltype = "llvm_i64_type" -(** [integer_type n] returns an integer type of bitwidth [n]. - See the method [llvm::IntegerType::get]. *) -external integer_type : int -> lltype = "llvm_integer_type" +(** [integer_type c n] returns an integer type of bitwidth [n] in the context + [c]. See the method [llvm::IntegerType::get]. *) +external integer_type : llcontext -> int -> lltype = "llvm_integer_type" -(** [integer_bitwidth ty] returns the number of bits in the integer type [ty]. - See the method [llvm::IntegerType::getBitWidth]. *) +(** [integer_bitwidth c ty] returns the number of bits in the integer type [ty] + in the context [c]. See the method [llvm::IntegerType::getBitWidth]. *) external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth" (** {7 Operations on real types} *) -(** The IEEE 32-bit floating point type. See [llvm::Type::FloatTy]. *) -val float_type : lltype +(** [float_type c] returns the IEEE 32-bit floating point type in the context + [c]. See [llvm::Type::FloatTy]. *) +external float_type : llcontext -> lltype = "llvm_float_type" -(** The IEEE 64-bit floating point type. See [llvm::Type::DoubleTy]. *) -val double_type : lltype +(** [double_type c] returns the IEEE 64-bit floating point type in the context + [c]. See [llvm::Type::DoubleTy]. *) +external double_type : llcontext -> lltype = "llvm_double_type" -(** The x87 80-bit floating point type. See [llvm::Type::X86_FP80Ty]. *) -val x86fp80_type : lltype +(** [x86fp80_type c] returns the x87 80-bit floating point type in the context + [c]. See [llvm::Type::X86_FP80Ty]. *) +external x86fp80_type : llcontext -> lltype = "llvm_x86fp80_type" -(** The IEEE 128-bit floating point type. See [llvm::Type::FP128Ty]. *) -val fp128_type : lltype +(** [fp128_type c] returns the IEEE 128-bit floating point type in the context + [c]. See [llvm::Type::FP128Ty]. *) +external fp128_type : llcontext -> lltype = "llvm_fp128_type" -(** The PowerPC 128-bit floating point type. See [llvm::Type::PPC_FP128Ty]. *) -val ppc_fp128_type : lltype +(** [ppc_fp128_type c] returns the PowerPC 128-bit floating point type in the + context [c]. See [llvm::Type::PPC_FP128Ty]. *) +external ppc_fp128_type : llcontext -> lltype = "llvm_ppc_fp128_type" (** {7 Operations on function types} *) @@ -405,18 +415,18 @@ external vector_size : lltype -> int = "llvm_vector_size" (** {7 Operations on other types} *) -(** [opaque_type ()] creates a new opaque type distinct from any other. - Opaque types are useful for building recursive types in combination with - {!refine_type}. - See [llvm::OpaqueType::get]. *) -external opaque_type : unit -> lltype = "llvm_opaque_type" +(** [opaque_type c] creates a new opaque type distinct from any other in the + context [c]. Opaque types are useful for building recursive types in + combination with {!refine_type}. See [llvm::OpaqueType::get]. *) +external opaque_type : llcontext -> lltype = "llvm_opaque_type" -(** [void_type] is the type of a function which does not return any value. - See [llvm::Type::VoidTy]. *) -val void_type : lltype +(** [void_type c] creates a type of a function which does not return any + value in the context [c]. See [llvm::Type::VoidTy]. *) +external void_type : llcontext -> lltype = "llvm_void_type" -(** [label_type] is the type of a basic block. See [llvm::Type::LabelTy]. *) -val label_type : lltype +(** [label_type c] creates a type of a basic block in the context [c]. See + [llvm::Type::LabelTy]. *) +external label_type : llcontext -> lltype = "llvm_label_type" (** {7 Operations on type handles} *) @@ -513,17 +523,18 @@ external const_float_of_string : lltype -> string -> llvalue (** {7 Operations on composite constants} *) -(** [const_string s] returns the constant [i8] array with the values of the - characters in the string [s]. The array is not null-terminated (but see - {!const_stringz}). This value can in turn be used as the initializer for a - global variable. See the method [llvm::ConstantArray::get]. *) -external const_string : string -> llvalue = "llvm_const_string" +(** [const_string c s] returns the constant [i8] array with the values of the + characters in the string [s] in the context [c]. The array is not + null-terminated (but see {!const_stringz}). This value can in turn be used + as the initializer for a global variable. See the method + [llvm::ConstantArray::get]. *) +external const_string : llcontext -> string -> llvalue = "llvm_const_string" -(** [const_stringz s] returns the constant [i8] array with the values of the - characters in the string [s] and a null terminator. This value can in turn - be used as the initializer for a global variable. +(** [const_stringz c s] returns the constant [i8] array with the values of the + characters in the string [s] and a null terminator in the context [c]. This + value can in turn be used as the initializer for a global variable. See the method [llvm::ConstantArray::get]. *) -external const_stringz : string -> llvalue = "llvm_const_stringz" +external const_stringz : llcontext -> string -> llvalue = "llvm_const_stringz" (** [const_array ty elts] returns the constant array of type [array_type ty (Array.length elts)] and containing the values [elts]. @@ -1159,15 +1170,16 @@ external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock" See the method [llvm::BasicBlock::eraseFromParent]. *) external delete_block : llbasicblock -> unit = "llvm_delete_block" -(** [append_block name f] creates a new basic block named [name] at the end of - function [f]. +(** [append_block c name f] creates a new basic block named [name] at the end of + function [f] in the context [c]. See the constructor of [llvm::BasicBlock]. *) -external append_block : string -> llvalue -> llbasicblock = "llvm_append_block" +external append_block : llcontext -> string -> llvalue -> llbasicblock + = "llvm_append_block" -(** [insert_block name bb] creates a new basic block named [name] before the - basic block [bb]. +(** [insert_block c name bb] creates a new basic block named [name] before the + basic block [bb] in the context [c]. See the constructor of [llvm::BasicBlock]. *) -external insert_block : string -> llbasicblock -> llbasicblock +external insert_block : llcontext -> string -> llbasicblock -> llbasicblock = "llvm_insert_block" (** [block_parent bb] returns the parent function that owns the basic block. diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 2fea055fecd..8868d07ffc7 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -178,16 +178,34 @@ CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) { /*--... Operations on integer types ........................................--*/ -/* unit -> lltype */ -CAMLprim LLVMTypeRef llvm_i1_type (value Unit) { return LLVMInt1Type(); } -CAMLprim LLVMTypeRef llvm_i8_type (value Unit) { return LLVMInt8Type(); } -CAMLprim LLVMTypeRef llvm_i16_type(value Unit) { return LLVMInt16Type(); } -CAMLprim LLVMTypeRef llvm_i32_type(value Unit) { return LLVMInt32Type(); } -CAMLprim LLVMTypeRef llvm_i64_type(value Unit) { return LLVMInt64Type(); } +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i1_type (LLVMContextRef Context) { + return LLVMInt1TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i8_type (LLVMContextRef Context) { + return LLVMInt8TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i16_type (LLVMContextRef Context) { + return LLVMInt16TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i32_type (LLVMContextRef Context) { + return LLVMInt32TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i64_type (LLVMContextRef Context) { + return LLVMInt64TypeInContext(Context); +} -/* int -> lltype */ -CAMLprim LLVMTypeRef llvm_integer_type(value Width) { - return LLVMIntType(Int_val(Width)); +/* llcontext -> int -> lltype */ +CAMLprim LLVMTypeRef llvm_integer_type(LLVMContextRef Context, value Width) { + return LLVMIntTypeInContext(Context, Int_val(Width)); } /* lltype -> int */ @@ -197,29 +215,29 @@ CAMLprim value llvm_integer_bitwidth(LLVMTypeRef IntegerTy) { /*--... Operations on real types ...........................................--*/ -/* unit -> lltype */ -CAMLprim LLVMTypeRef llvm_float_type(value Unit) { - return LLVMFloatType(); +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_float_type(LLVMContextRef Context) { + return LLVMFloatTypeInContext(Context); } -/* unit -> lltype */ -CAMLprim LLVMTypeRef llvm_double_type(value Unit) { - return LLVMDoubleType(); +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_double_type(LLVMContextRef Context) { + return LLVMDoubleTypeInContext(Context); } -/* unit -> lltype */ -CAMLprim LLVMTypeRef llvm_x86fp80_type(value Unit) { - return LLVMX86FP80Type(); +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_x86fp80_type(LLVMContextRef Context) { + return LLVMX86FP80TypeInContext(Context); } -/* unit -> lltype */ -CAMLprim LLVMTypeRef llvm_fp128_type(value Unit) { - return LLVMFP128Type(); +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_fp128_type(LLVMContextRef Context) { + return LLVMFP128TypeInContext(Context); } -/* unit -> lltype */ -CAMLprim LLVMTypeRef llvm_ppc_fp128_type(value Unit) { - return LLVMPPCFP128Type(); +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) { + return LLVMPPCFP128TypeInContext(Context); } /*--... Operations on function types .......................................--*/ @@ -316,13 +334,19 @@ CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) { /*--... Operations on other types ..........................................--*/ -/* unit -> lltype */ -CAMLprim LLVMTypeRef llvm_void_type (value Unit) { return LLVMVoidType(); } -CAMLprim LLVMTypeRef llvm_label_type(value Unit) { return LLVMLabelType(); } +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_void_type (LLVMContextRef Context) { + return LLVMVoidTypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) { + return LLVMLabelTypeInContext(Context); +} -/* unit -> lltype */ -CAMLprim LLVMTypeRef llvm_opaque_type(value Unit) { - return LLVMOpaqueType(); +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_opaque_type(LLVMContextRef Context) { + return LLVMOpaqueTypeInContext(Context); } /*--... Operations on type handles .........................................--*/ @@ -432,14 +456,18 @@ CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) { /*--... Operations on composite constants ..................................--*/ -/* string -> llvalue */ -CAMLprim LLVMValueRef llvm_const_string(value Str, value NullTerminate) { - return LLVMConstString(String_val(Str), string_length(Str), 1); +/* llcontext -> string -> llvalue */ +CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str, + value NullTerminate) { + return LLVMConstStringInContext(Context, String_val(Str), string_length(Str), + 1); } -/* string -> llvalue */ -CAMLprim LLVMValueRef llvm_const_stringz(value Str, value NullTerminate) { - return LLVMConstString(String_val(Str), string_length(Str), 0); +/* llcontext -> string -> llvalue */ +CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str, + value NullTerminate) { + return LLVMConstStringInContext(Context, String_val(Str), string_length(Str), + 0); } /* lltype -> llvalue array -> llvalue */ @@ -697,7 +725,7 @@ CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) { CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty, LLVMModuleRef M) { LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty); - LLVMAppendBasicBlock(Fn, "entry"); + LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry"); return Fn; } @@ -810,13 +838,15 @@ CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) { } /* string -> llvalue -> llbasicblock */ -CAMLprim LLVMBasicBlockRef llvm_append_block(value Name, LLVMValueRef Fn) { - return LLVMAppendBasicBlock(Fn, String_val(Name)); +CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name, + LLVMValueRef Fn) { + return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name)); } /* string -> llbasicblock -> llbasicblock */ -CAMLprim LLVMBasicBlockRef llvm_insert_block(value Name, LLVMBasicBlockRef BB) { - return LLVMInsertBasicBlock(BB, String_val(Name)); +CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name, + LLVMBasicBlockRef BB) { + return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name)); } /* llvalue -> bool */ diff --git a/test/Bindings/Ocaml/analysis.ml b/test/Bindings/Ocaml/analysis.ml index f1fbe32a82d..29ebb922474 100644 --- a/test/Bindings/Ocaml/analysis.ml +++ b/test/Bindings/Ocaml/analysis.ml @@ -8,6 +8,8 @@ open Llvm_analysis (* Note that this takes a moment to link, so it's best to keep the number of individual tests low. *) +let context = global_context () + let test x = if not x then exit 1 else () let bomb msg = @@ -15,10 +17,10 @@ let bomb msg = exit 2 let _ = - let fty = function_type void_type [| |] in - let m = create_module (global_context ()) "valid_m" in + let fty = function_type (void_type context) [| |] in + let m = create_module context "valid_m" in let fn = define_function "valid_fn" fty m in - let at_entry = builder_at_end (global_context ()) (entry_block fn) in + let at_entry = builder_at_end context (entry_block fn) in ignore (build_ret_void at_entry); diff --git a/test/Bindings/Ocaml/bitreader.ml b/test/Bindings/Ocaml/bitreader.ml index 2b931232162..2abeda95f52 100644 --- a/test/Bindings/Ocaml/bitreader.ml +++ b/test/Bindings/Ocaml/bitreader.ml @@ -14,7 +14,7 @@ let _ = let fn = Sys.argv.(1) in let m = Llvm.create_module context "ocaml_test_module" in - ignore (Llvm.define_type_name "caml_int_ty" Llvm.i32_type m); + ignore (Llvm.define_type_name "caml_int_ty" (Llvm.i32_type context) m); test (Llvm_bitwriter.write_bitcode_file m fn); diff --git a/test/Bindings/Ocaml/bitwriter.ml b/test/Bindings/Ocaml/bitwriter.ml index bb769b21738..42c8daec5d2 100644 --- a/test/Bindings/Ocaml/bitwriter.ml +++ b/test/Bindings/Ocaml/bitwriter.ml @@ -6,11 +6,13 @@ (* Note that this takes a moment to link, so it's best to keep the number of individual tests low. *) +let context = Llvm.global_context () + let test x = if not x then exit 1 else () let _ = - let m = Llvm.create_module (Llvm.global_context ()) "ocaml_test_module" in + let m = Llvm.create_module context "ocaml_test_module" in - ignore (Llvm.define_type_name "caml_int_ty" Llvm.i32_type m); + ignore (Llvm.define_type_name "caml_int_ty" (Llvm.i32_type context) m); test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1)) diff --git a/test/Bindings/Ocaml/executionengine.ml b/test/Bindings/Ocaml/executionengine.ml index 56cf6e86c79..420a14f67c5 100644 --- a/test/Bindings/Ocaml/executionengine.ml +++ b/test/Bindings/Ocaml/executionengine.ml @@ -9,6 +9,12 @@ open Llvm_target (* Note that this takes a moment to link, so it's best to keep the number of individual tests low. *) +let context = global_context () +let i8_type = Llvm.i8_type context +let i32_type = Llvm.i32_type context +let i64_type = Llvm.i64_type context +let double_type = Llvm.double_type context + let bomb msg = prerr_endline msg; exit 2 diff --git a/test/Bindings/Ocaml/scalar_opts.ml b/test/Bindings/Ocaml/scalar_opts.ml index 936a0524f83..8f6802da765 100644 --- a/test/Bindings/Ocaml/scalar_opts.ml +++ b/test/Bindings/Ocaml/scalar_opts.ml @@ -9,6 +9,8 @@ open Llvm open Llvm_scalar_opts open Llvm_target +let context = global_context () +let void_type = Llvm.void_type context (* Tiny unit test framework - really just to help find which line is busted *) let suite name f = @@ -19,7 +21,7 @@ let suite name f = (*===-- Fixture -----------------------------------------------------------===*) let filename = Sys.argv.(1) -let m = create_module (global_context ()) filename +let m = create_module context filename let mp = ModuleProvider.create m @@ -30,7 +32,7 @@ let test_transforms () = let fty = function_type void_type [| |] in let fn = define_function "fn" fty m in - ignore (build_ret_void (builder_at_end (global_context ()) (entry_block fn))); + ignore (build_ret_void (builder_at_end context (entry_block fn))); let td = TargetData.create (target_triple m) in diff --git a/test/Bindings/Ocaml/target.ml b/test/Bindings/Ocaml/target.ml index 385bc8131e2..f7d1cbf2859 100644 --- a/test/Bindings/Ocaml/target.ml +++ b/test/Bindings/Ocaml/target.ml @@ -8,6 +8,10 @@ open Llvm open Llvm_target +let context = global_context () +let i32_type = Llvm.i32_type context +let i64_type = Llvm.i64_type context + (* Tiny unit test framework - really just to help find which line is busted *) let suite name f = prerr_endline (name ^ ":"); @@ -17,14 +21,14 @@ let suite name f = (*===-- Fixture -----------------------------------------------------------===*) let filename = Sys.argv.(1) -let m = create_module (global_context ()) filename +let m = create_module context filename (*===-- Target Data -------------------------------------------------------===*) let test_target_data () = let td = TargetData.create (target_triple m) in - let sty = struct_type (global_context ()) [| i32_type; i64_type |] in + let sty = struct_type context [| i32_type; i64_type |] in ignore (TargetData.as_string td); ignore (TargetData.invalidate_struct_layout td sty); diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index f1fa23cc949..4f6d3eabf25 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -18,6 +18,15 @@ let group_name = ref "" let case_num = ref 0 let print_checkpoints = false let context = global_context () +let i1_type = Llvm.i1_type context +let i8_type = Llvm.i8_type context +let i16_type = Llvm.i16_type context +let i32_type = Llvm.i32_type context +let i64_type = Llvm.i64_type context +let void_type = Llvm.void_type context +let float_type = Llvm.float_type context +let double_type = Llvm.double_type context +let fp128_type = Llvm.fp128_type context let group name = group_name := !suite_name ^ "/" ^ name; @@ -94,7 +103,7 @@ let test_types () = (* RUN: grep {Ty04.*i42} < %t.ll *) group "i42"; - let ty = integer_type 42 in + let ty = integer_type context 42 in insist (define_type_name "Ty04" ty m); (* RUN: grep {Ty05.*float} < %t.ll @@ -165,22 +174,22 @@ let test_types () = (* RUN: grep {Ty12.*opaque} < %t.ll *) group "opaque"; - let ty = opaque_type () in + let ty = opaque_type context in insist (define_type_name "Ty12" ty m); insist (ty == ty); - insist (ty <> opaque_type ()); + insist (ty <> opaque_type context); (* RUN: grep -v {Ty13} < %t.ll *) group "delete"; - let ty = opaque_type () in + let ty = opaque_type context in insist (define_type_name "Ty13" ty m); delete_type_name "Ty13" m; (* RUN: grep -v {RecursiveTy.*RecursiveTy} < %t.ll *) group "recursive"; - let ty = opaque_type () in + let ty = opaque_type context in let th = handle_to_type ty in refine_type ty (pointer_type ty); let ty = type_of_handle th in @@ -223,14 +232,14 @@ let test_constants () = (* RUN: grep {Const04.*"cruel\\\\00world"} < %t.ll *) group "string"; - let c = const_string "cruel\000world" in + let c = const_string context "cruel\000world" in ignore (define_global "Const04" c m); insist ((array_type i8_type 11) = type_of c); (* RUN: grep {Const05.*"hi\\\\00again\\\\00"} < %t.ll *) group "stringz"; - let c = const_stringz "hi\000again" in + let c = const_stringz context "hi\000again" in ignore (define_global "Const05" c m); insist ((array_type i8_type 9) = type_of c); @@ -356,7 +365,7 @@ let test_constants () = * RUN: grep {ConstIntToPtr.*inttoptr} < %t.ll * RUN: grep {ConstBitCast.*bitcast} < %t.ll *) - let i128_type = integer_type 128 in + let i128_type = integer_type context 128 in ignore (define_global "ConstTrunc" (const_trunc (const_add foldbomb five) i8_type) m); ignore (define_global "ConstSExt" (const_sext foldbomb i128_type) m); @@ -673,7 +682,7 @@ let test_basic_blocks () = *) group "entry"; let fn = declare_function "X" ty m in - let bb = append_block "Bb1" fn in + let bb = append_block context "Bb1" fn in insist (bb = entry_block fn); ignore (build_unreachable (builder_at_end context bb)); @@ -681,13 +690,13 @@ let test_basic_blocks () = *) group "delete"; let fn = declare_function "X2" ty m in - let bb = append_block "Bb2" fn in + let bb = append_block context "Bb2" fn in delete_block bb; group "insert"; let fn = declare_function "X3" ty m in - let bbb = append_block "b" fn in - let bba = insert_block "a" bbb in + let bbb = append_block context "b" fn in + let bba = insert_block context "a" bbb in insist ([| bba; bbb |] = basic_blocks fn); ignore (build_unreachable (builder_at_end context bba)); ignore (build_unreachable (builder_at_end context bbb)); @@ -717,8 +726,8 @@ let test_basic_blocks () = insist (At_end f = block_begin f); insist (At_start f = block_end f); - let b1 = append_block "One" f in - let b2 = append_block "Two" f in + let b1 = append_block context "One" f in + let b2 = append_block context "Two" f in insist (Before b1 = block_begin f); insist (Before b2 = block_succ b1); @@ -804,7 +813,7 @@ let test_builder () = *) let fty = function_type void_type [| |] in let fn = declare_function "X6" fty m in - let b = builder_at_end context (append_block "Bb01" fn) in + let b = builder_at_end context (append_block context "Bb01" fn) in ignore (build_ret_void b) end; @@ -817,7 +826,7 @@ let test_builder () = let f1 = build_uitofp p1 float_type "F1" atentry in let f2 = build_uitofp p2 float_type "F2" atentry in - let bb00 = append_block "Bb00" fn in + let bb00 = append_block context "Bb00" fn in ignore (build_unreachable (builder_at_end context bb00)); group "ret"; begin @@ -830,7 +839,7 @@ let test_builder () = group "br"; begin (* RUN: grep {br.*Bb02} < %t.ll *) - let bb02 = append_block "Bb02" fn in + let bb02 = append_block context "Bb02" fn in let b = builder_at_end context bb02 in ignore (build_br bb02 b) end; @@ -838,7 +847,7 @@ let test_builder () = group "cond_br"; begin (* RUN: grep {br.*Inst01.*Bb03.*Bb00} < %t.ll *) - let bb03 = append_block "Bb03" fn in + let bb03 = append_block context "Bb03" fn in let b = builder_at_end context bb03 in let cond = build_trunc p1 i1_type "Inst01" b in ignore (build_cond_br cond bb03 bb00 b) @@ -848,10 +857,10 @@ let test_builder () = (* RUN: grep {switch.*P1.*SwiBlock3} < %t.ll * RUN: grep {2,.*SwiBlock2} < %t.ll *) - let bb1 = append_block "SwiBlock1" fn in - let bb2 = append_block "SwiBlock2" fn in + let bb1 = append_block context "SwiBlock1" fn in + let bb2 = append_block context "SwiBlock2" fn in ignore (build_unreachable (builder_at_end context bb2)); - let bb3 = append_block "SwiBlock3" fn in + let bb3 = append_block context "SwiBlock3" fn in ignore (build_unreachable (builder_at_end context bb3)); let si = build_switch p1 bb3 1 (builder_at_end context bb1) in ignore (add_case si (const_int i32_type 2) bb2) @@ -861,7 +870,7 @@ let test_builder () = (* RUN: grep {Inst02.*invoke.*P1.*P2} < %t.ll * RUN: grep {to.*Bb04.*unwind.*Bb00} < %t.ll *) - let bb04 = append_block "Bb04" fn in + let bb04 = append_block context "Bb04" fn in let b = builder_at_end context bb04 in ignore (build_invoke fn [| p1; p2 |] bb04 bb00 "Inst02" b) end; @@ -869,7 +878,7 @@ let test_builder () = group "unwind"; begin (* RUN: grep {unwind} < %t.ll *) - let bb05 = append_block "Bb05" fn in + let bb05 = append_block context "Bb05" fn in let b = builder_at_end context bb05 in ignore (build_unwind b) end; @@ -877,13 +886,13 @@ let test_builder () = group "unreachable"; begin (* RUN: grep {unreachable} < %t.ll *) - let bb06 = append_block "Bb06" fn in + let bb06 = append_block context "Bb06" fn in let b = builder_at_end context bb06 in ignore (build_unreachable b) end; group "arithmetic"; begin - let bb07 = append_block "Bb07" fn in + let bb07 = append_block context "Bb07" fn in let b = builder_at_end context bb07 in (* RUN: grep {Inst03.*add.*P1.*P2} < %t.ll @@ -925,7 +934,7 @@ let test_builder () = end; group "memory"; begin - let bb08 = append_block "Bb08" fn in + let bb08 = append_block context "Bb08" fn in let b = builder_at_end context bb08 in (* RUN: grep {Inst20.*malloc.*i8 } < %t.ll @@ -1034,10 +1043,10 @@ let test_builder () = group "phi"; begin (* RUN: grep {PhiNode.*P1.*PhiBlock1.*P2.*PhiBlock2} < %t.ll *) - let b1 = append_block "PhiBlock1" fn in - let b2 = append_block "PhiBlock2" fn in + let b1 = append_block context "PhiBlock1" fn in + let b2 = append_block context "PhiBlock2" fn in - let jb = append_block "PhiJoinBlock" fn in + let jb = append_block context "PhiJoinBlock" fn in ignore (build_br jb (builder_at_end context b1)); ignore (build_br jb (builder_at_end context b2)); let at_jb = builder_at_end context jb in