summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorErick Tryzelaar <idadesub@users.sourceforge.net>2009-08-19 17:32:24 +0000
committerErick Tryzelaar <idadesub@users.sourceforge.net>2009-08-19 17:32:24 +0000
commitb02b87882788e57e180c6b903a37ced0db1ce828 (patch)
tree988e30329d11fccacee72ea81c8a90b78f2a277a
parentc34ebf65af0139eaf5cb0969fabcd32c0b6e1710 (diff)
downloadllvm-b02b87882788e57e180c6b903a37ced0db1ce828.tar.gz
llvm-b02b87882788e57e180c6b903a37ced0db1ce828.tar.bz2
llvm-b02b87882788e57e180c6b903a37ced0db1ce828.tar.xz
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
-rw-r--r--bindings/ocaml/llvm/llvm.ml54
-rw-r--r--bindings/ocaml/llvm/llvm.mli112
-rw-r--r--bindings/ocaml/llvm/llvm_ocaml.c112
-rw-r--r--test/Bindings/Ocaml/analysis.ml8
-rw-r--r--test/Bindings/Ocaml/bitreader.ml2
-rw-r--r--test/Bindings/Ocaml/bitwriter.ml6
-rw-r--r--test/Bindings/Ocaml/executionengine.ml6
-rw-r--r--test/Bindings/Ocaml/scalar_opts.ml6
-rw-r--r--test/Bindings/Ocaml/target.ml8
-rw-r--r--test/Bindings/Ocaml/vmcore.ml67
10 files changed, 217 insertions, 164 deletions
diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 74fd1f1e17..25707027b0 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 1eaa7fa18a..789a975201 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 2fea055fec..8868d07ffc 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 f1fbe32a82..29ebb92247 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 2b93123216..2abeda95f5 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 bb769b2173..42c8daec5d 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 56cf6e86c7..420a14f67c 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 936a0524f8..8f6802da76 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 385bc8131e..f7d1cbf285 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 f1fa23cc94..4f6d3eabf2 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