[llvm-commits] [llvm] r79410 - in /llvm/trunk: bindings/ocaml/bitreader/bitreader_ocaml.c bindings/ocaml/bitreader/llvm_bitreader.ml bindings/ocaml/bitreader/llvm_bitreader.mli bindings/ocaml/llvm/llvm.ml bindings/ocaml/llvm/llvm.mli bindings/ocaml/llvm/llvm_ocaml.c test/Bindings/Ocaml/analysis.ml test/Bindings/Ocaml/bitreader.ml test/Bindings/Ocaml/bitwriter.ml test/Bindings/Ocaml/executionengine.ml test/Bindings/Ocaml/scalar_opts.ml test/Bindings/Ocaml/target.ml test/Bindings/Ocaml/vmcore.ml
Erick Tryzelaar
idadesub at users.sourceforge.net
Tue Aug 18 23:40:29 PDT 2009
Author: erickt
Date: Wed Aug 19 01:40:29 2009
New Revision: 79410
URL: http://llvm.org/viewvc/llvm-project?rev=79410&view=rev
Log:
Allow passing around LLVMContext in ocaml.
Modified:
llvm/trunk/bindings/ocaml/bitreader/bitreader_ocaml.c
llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.ml
llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.mli
llvm/trunk/bindings/ocaml/llvm/llvm.ml
llvm/trunk/bindings/ocaml/llvm/llvm.mli
llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
llvm/trunk/test/Bindings/Ocaml/analysis.ml
llvm/trunk/test/Bindings/Ocaml/bitreader.ml
llvm/trunk/test/Bindings/Ocaml/bitwriter.ml
llvm/trunk/test/Bindings/Ocaml/executionengine.ml
llvm/trunk/test/Bindings/Ocaml/scalar_opts.ml
llvm/trunk/test/Bindings/Ocaml/target.ml
llvm/trunk/test/Bindings/Ocaml/vmcore.ml
Modified: llvm/trunk/bindings/ocaml/bitreader/bitreader_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/bitreader/bitreader_ocaml.c?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/bitreader/bitreader_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/bitreader/bitreader_ocaml.c Wed Aug 19 01:40:29 2009
@@ -45,27 +45,29 @@
/*===-- Modules -----------------------------------------------------------===*/
-/* Llvm.llmemorybuffer -> Llvm.module */
-CAMLprim value llvm_get_module_provider(LLVMMemoryBufferRef MemBuf) {
+/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */
+CAMLprim value llvm_get_module_provider(LLVMContextRef C,
+ LLVMMemoryBufferRef MemBuf) {
CAMLparam0();
CAMLlocal2(Variant, MessageVal);
char *Message;
LLVMModuleProviderRef MP;
- if (LLVMGetBitcodeModuleProvider(MemBuf, &MP, &Message))
+ if (LLVMGetBitcodeModuleProviderInContext(C, MemBuf, &MP, &Message))
llvm_raise(llvm_bitreader_error_exn, Message);
CAMLreturn((value) MemBuf);
}
-/* Llvm.llmemorybuffer -> Llvm.llmodule */
-CAMLprim value llvm_parse_bitcode(LLVMMemoryBufferRef MemBuf) {
+/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */
+CAMLprim value llvm_parse_bitcode(LLVMContextRef C,
+ LLVMMemoryBufferRef MemBuf) {
CAMLparam0();
CAMLlocal2(Variant, MessageVal);
LLVMModuleRef M;
char *Message;
- if (LLVMParseBitcode(MemBuf, &M, &Message))
+ if (LLVMParseBitcodeInContext(C, MemBuf, &M, &Message))
llvm_raise(llvm_bitreader_error_exn, Message);
CAMLreturn((value) M);
Modified: llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.ml?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.ml (original)
+++ llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.ml Wed Aug 19 01:40:29 2009
@@ -13,7 +13,9 @@
external register_exns : exn -> unit = "llvm_register_bitreader_exns"
let _ = register_exns (Error "")
-external get_module_provider : Llvm.llmemorybuffer -> Llvm.llmoduleprovider
+external get_module_provider : Llvm.llcontext -> Llvm.llmemorybuffer ->
+ Llvm.llmoduleprovider
= "llvm_get_module_provider"
-external parse_bitcode : Llvm.llmemorybuffer -> Llvm.llmodule
+
+external parse_bitcode : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
= "llvm_parse_bitcode"
Modified: llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.mli?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.mli (original)
+++ llvm/trunk/bindings/ocaml/bitreader/llvm_bitreader.mli Wed Aug 19 01:40:29 2009
@@ -14,16 +14,18 @@
exception Error of string
-(** [read_bitcode_file path] reads the bitcode for a new module [m] from the
- file at [path]. Returns [Success m] if successful, and [Failure msg]
- otherwise, where [msg] is a description of the error encountered.
- See the function [llvm::getBitcodeModuleProvider]. *)
-external get_module_provider : Llvm.llmemorybuffer -> Llvm.llmoduleprovider
+(** [get_module_provider context mb] reads the bitcode for a new
+ module provider [m] from the memory buffer [mb] in the context [context].
+ Returns [m] if successful, or raises [Error msg] otherwise, where [msg] is a
+ description of the error encountered. See the function
+ [llvm::getBitcodeModuleProvider]. *)
+external get_module_provider : Llvm.llcontext -> Llvm.llmemorybuffer ->
+ Llvm.llmoduleprovider
= "llvm_get_module_provider"
-(** [parse_bitcode mb] parses the bitcode for a new module [m] from the memory
- buffer [mb]. Returns [Success m] if successful, and [Failure msg] otherwise,
- where [msg] is a description of the error encountered.
- See the function [llvm::ParseBitcodeFile]. *)
-external parse_bitcode : Llvm.llmemorybuffer -> Llvm.llmodule
+(** [parse_bitcode context mb] parses the bitcode for a new module [m] from the
+ memory buffer [mb] in the context [context]. Returns [m] if successful, or
+ raises [Error msg] otherwise, where [msg] is a description of the error
+ encountered. See the function [llvm::ParseBitcodeFile]. *)
+external parse_bitcode : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
= "llvm_parse_bitcode"
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.ml?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Wed Aug 19 01:40:29 2009
@@ -8,6 +8,7 @@
*===----------------------------------------------------------------------===*)
+type llcontext
type llmodule
type lltype
type lltypehandle
@@ -127,10 +128,13 @@
| At_start of 'a
| After of 'b
+(*===-- Contexts ----------------------------------------------------------===*)
+external create_context : unit -> llcontext = "llvm_create_context"
+external dispose_context : unit -> llcontext = "llvm_dispose_context"
+external global_context : unit -> llcontext = "llvm_global_context"
(*===-- Modules -----------------------------------------------------------===*)
-
-external create_module : string -> llmodule = "llvm_create_module"
+external create_module : llcontext -> string -> llmodule = "llvm_create_module"
external dispose_module : llmodule -> unit = "llvm_dispose_module"
external target_triple: llmodule -> string
= "llvm_target_triple"
@@ -147,8 +151,8 @@
external dump_module : llmodule -> unit = "llvm_dump_module"
(*===-- Types -------------------------------------------------------------===*)
-
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"
@@ -188,8 +192,9 @@
external param_types : lltype -> lltype array = "llvm_param_types"
(*--... Operations on struct types .........................................--*)
-external struct_type : lltype array -> lltype = "llvm_struct_type"
-external packed_struct_type : lltype array -> lltype = "llvm_packed_struct_type"
+external struct_type : llcontext -> lltype array -> lltype = "llvm_struct_type"
+external packed_struct_type : llcontext -> lltype array -> lltype
+ = "llvm_packed_struct_type"
external element_types : lltype -> lltype array = "llvm_element_types"
external is_packed : lltype -> bool = "llvm_is_packed"
@@ -247,8 +252,9 @@
external const_string : string -> llvalue = "llvm_const_string"
external const_stringz : string -> llvalue = "llvm_const_stringz"
external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array"
-external const_struct : llvalue array -> llvalue = "llvm_const_struct"
-external const_packed_struct : llvalue array -> llvalue
+external const_struct : llcontext -> llvalue array -> llvalue
+ = "llvm_const_struct"
+external const_packed_struct : llcontext -> llvalue array -> llvalue
= "llvm_const_packed_struct"
external const_vector : llvalue array -> llvalue = "llvm_const_vector"
@@ -654,20 +660,20 @@
(*===-- Instruction builders ----------------------------------------------===*)
-external builder : unit -> llbuilder = "llvm_builder"
+external builder : llcontext -> llbuilder = "llvm_builder"
external position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit
= "llvm_position_builder"
external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block"
external insert_into_builder : llvalue -> string -> llbuilder -> unit
= "llvm_insert_into_builder"
-let builder_at ip =
- let b = builder () in
+let builder_at context ip =
+ let b = builder context in
position_builder ip b;
b
-let builder_before i = builder_at (Before i)
-let builder_at_end bb = builder_at (At_end bb)
+let builder_before context i = builder_at context (Before i)
+let builder_at_end context bb = builder_at context (At_end bb)
let position_before i = position_builder (Before i)
let position_at_end bb = position_builder (At_end bb)
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.mli?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.mli (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.mli Wed Aug 19 01:40:29 2009
@@ -17,6 +17,10 @@
These abstract types correlate directly to the LLVM VMCore classes. *)
+(** The top-level container for all LLVM global data. See the
+ [llvm::LLVMContext] class. *)
+type llcontext
+
(** The top-level container for all other LLVM Intermediate Representation (IR)
objects. See the [llvm::Module] class. *)
type llmodule
@@ -188,12 +192,27 @@
exception IoError of string
+(** {6 Contexts} *)
+
+(** [create_context ()] creates a context for storing the "global" state in
+ LLVM. See the constructor [llvm::LLVMContext]. *)
+external create_context : unit -> llcontext = "llvm_create_context"
+
+(** [destroy_context ()] destroys a context. See the destructor
+ [llvm::LLVMContext::~LLVMContext]. *)
+external dispose_context : unit -> llcontext = "llvm_dispose_context"
+
+(** See the function [llvm::getGlobalContext]. *)
+external global_context : unit -> llcontext = "llvm_global_context"
+
+
(** {6 Modules} *)
-(** [create_module id] creates a module with the supplied module ID. Modules are
- not garbage collected; it is mandatory to call {!dispose_module} to free
- memory. See the constructor [llvm::Module::Module]. *)
-external create_module : string -> llmodule = "llvm_create_module"
+(** [create_module context id] creates a module with the supplied module ID in
+ the context [context]. Modules are not garbage collected; it is mandatory
+ to call {!dispose_module} to free memory. See the constructor
+ [llvm::Module::Module]. *)
+external create_module : llcontext -> string -> llmodule = "llvm_create_module"
(** [dispose_module m] destroys a module [m] and all of the IR objects it
contained. All references to subordinate objects are invalidated;
@@ -245,6 +264,10 @@
See the method [llvm::Type::getTypeID]. *)
external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
+(** [type_context ty] returns the {!llcontext} corresponding to the type [ty].
+ See the method [llvm::Type::getContext]. *)
+external type_context : lltype -> llcontext = "llvm_type_context"
+
(** [string_of_lltype ty] returns a string describing the type [ty]. *)
val string_of_lltype : lltype -> string
@@ -321,13 +344,17 @@
(** {7 Operations on struct types} *)
-(** [struct_type tys] returns the structure type containing in the types in the
- array [tys]. See the method [llvm::StructType::get]. *)
-external struct_type : lltype array -> lltype = "llvm_struct_type"
-
-(** [packed_struct_type tys] returns the packed structure type containing in the
- types in the array [tys]. See the method [llvm::StructType::get]. *)
-external packed_struct_type : lltype array -> lltype = "llvm_packed_struct_type"
+(** [struct_type context tys] returns the structure type in the context
+ [context] containing in the types in the array [tys]. See the method
+ [llvm::StructType::get]. *)
+external struct_type : llcontext -> lltype array -> lltype
+ = "llvm_struct_type"
+
+(** [packed_struct_type context ys] returns the packed structure type in the
+ context [context] containing in the types in the array [tys]. See the method
+ [llvm::StructType::get]. *)
+external packed_struct_type : llcontext -> lltype array -> lltype
+ = "llvm_packed_struct_type"
(** [element_types sty] returns the constituent types of the struct type [sty].
See the method [llvm::StructType::getElementType]. *)
@@ -504,17 +531,19 @@
See the method [llvm::ConstantArray::get]. *)
external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array"
-(** [const_struct elts] returns the structured constant of type
- [struct_type (Array.map type_of elts)] and containing the values [elts].
- This value can in turn be used as the initializer for a global variable.
- See the method [llvm::ConstantStruct::get]. *)
-external const_struct : llvalue array -> llvalue = "llvm_const_struct"
-
-(** [const_packed_struct elts] returns the structured constant of type
- {!packed_struct_type} [(Array.map type_of elts)] and containing the values
- [elts]. This value can in turn be used as the initializer for a global
- variable. See the method [llvm::ConstantStruct::get]. *)
-external const_packed_struct : llvalue array -> llvalue
+(** [const_struct context elts] returns the structured constant of type
+ [struct_type (Array.map type_of elts)] and containing the values [elts]
+ in the context [context]. This value can in turn be used as the initializer
+ for a global variable. See the method [llvm::ConstantStruct::get]. *)
+external const_struct : llcontext -> llvalue array -> llvalue
+ = "llvm_const_struct"
+
+(** [const_packed_struct context elts] returns the structured constant of
+ type {!packed_struct_type} [(Array.map type_of elts)] and containing the
+ values [elts] in the context [context]. This value can in turn be used as
+ the initializer for a global variable. See the method
+ [llvm::ConstantStruct::get]. *)
+external const_packed_struct : llcontext -> llvalue array -> llvalue
= "llvm_const_packed_struct"
(** [const_vector elts] returns the vector constant of type
@@ -590,7 +619,7 @@
(** [const_exact_sdiv c1 c2] returns the constant quotient [c1 / c2] of two
signed integer constants. The result is undefined if the result is rounded
- or overflows. See the method [llvm::ConstantExpr::getExactSDiv]. *)
+ or overflows. See the method [llvm::ConstantExpr::getExactSDiv]. *)
external const_exact_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstExactSDiv"
(** [const_fdiv c1 c2] returns the constant quotient [c1 / c2] of two floating
@@ -757,7 +786,7 @@
= "LLVMConstIntCast"
(** [const_fpcast c ty] returns a constant fpext, bitcast, or fptrunc for fp ->
- fp casts of constant [c] to type [ty].
+ fp casts of constant [c] to type [ty].
See the method [llvm::ConstantExpr::getFPCast]. *)
external const_fpcast : llvalue -> lltype -> llvalue
= "LLVMConstFPCast"
@@ -1297,22 +1326,23 @@
(** {6 Instruction builders} *)
-(** [builder ()] creates an instruction builder with no position. It is invalid
- to use this builder until its position is set with {!position_before} or
- {!position_at_end}. See the constructor for [llvm::LLVMBuilder]. *)
-external builder : unit -> llbuilder = "llvm_builder"
+(** [builder context] creates an instruction builder with no position in
+ the context [context]. It is invalid to use this builder until its position
+ is set with {!position_before} or {!position_at_end}. See the constructor
+ for [llvm::LLVMBuilder]. *)
+external builder : llcontext -> llbuilder = "llvm_builder"
(** [builder_at ip] creates an instruction builder positioned at [ip].
See the constructor for [llvm::LLVMBuilder]. *)
-val builder_at : (llbasicblock, llvalue) llpos -> llbuilder
+val builder_at : llcontext -> (llbasicblock, llvalue) llpos -> llbuilder
(** [builder_before ins] creates an instruction builder positioned before the
instruction [isn]. See the constructor for [llvm::LLVMBuilder]. *)
-val builder_before : llvalue -> llbuilder
+val builder_before : llcontext -> llvalue -> llbuilder
(** [builder_at_end bb] creates an instruction builder positioned at the end of
the basic block [bb]. See the constructor for [llvm::LLVMBuilder]. *)
-val builder_at_end : llbasicblock -> llbuilder
+val builder_at_end : llcontext -> llbasicblock -> llbuilder
(** [position_builder ip bb] moves the instruction builder [bb] to the position
[ip].
@@ -1648,7 +1678,7 @@
(** [build_global_stringptr str name b] creates a series of instructions that
adds a global string pointer at the position specified by the instruction
- builder [b].
+ builder [b].
See the method [llvm::LLVMBuilder::CreateGlobalStringPtr]. *)
external build_global_stringptr : string -> string -> llbuilder -> llvalue
= "llvm_build_global_stringptr"
@@ -1876,7 +1906,7 @@
(** [build_ptrdiff lhs rhs name b] creates a series of instructions that measure
the difference between two pointer values at the position specified by the
- instruction builder [b].
+ instruction builder [b].
See the method [llvm::LLVMBuilder::CreatePtrDiff]. *)
external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue
= "llvm_build_ptrdiff"
Modified: llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c Wed Aug 19 01:40:29 2009
@@ -92,6 +92,24 @@
}
+/*===-- Contexts ----------------------------------------------------------===*/
+
+/* unit -> llcontext */
+CAMLprim LLVMContextRef llvm_create_context(value Unit) {
+ return LLVMContextCreate();
+}
+
+/* llcontext -> unit */
+CAMLprim value llvm_dispose_context(LLVMContextRef C) {
+ LLVMContextDispose(C);
+ return Val_unit;
+}
+
+/* unit -> llcontext */
+CAMLprim LLVMContextRef llvm_global_context(value Unit) {
+ return LLVMGetGlobalContext();
+}
+
/*===-- Modules -----------------------------------------------------------===*/
/* string -> llmodule */
@@ -153,6 +171,11 @@
return Val_int(LLVMGetTypeKind(Ty));
}
+/* lltype -> llcontext */
+CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) {
+ return LLVMGetTypeContext(Ty);
+}
+
/*--... Operations on integer types ........................................--*/
/* unit -> lltype */
@@ -228,16 +251,17 @@
/*--... Operations on struct types .........................................--*/
-/* lltype array -> lltype */
-CAMLprim LLVMTypeRef llvm_struct_type(value ElementTypes) {
- return LLVMStructType((LLVMTypeRef *) ElementTypes,
- Wosize_val(ElementTypes), 0);
+/* llcontext -> lltype array -> lltype */
+CAMLprim LLVMTypeRef llvm_struct_type(LLVMContextRef C, value ElementTypes) {
+ return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
+ Wosize_val(ElementTypes), 0);
}
-/* lltype array -> lltype */
-CAMLprim LLVMTypeRef llvm_packed_struct_type(value ElementTypes) {
- return LLVMStructType((LLVMTypeRef *) ElementTypes,
- Wosize_val(ElementTypes), 1);
+/* llcontext -> lltype array -> lltype */
+CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C,
+ value ElementTypes) {
+ return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
+ Wosize_val(ElementTypes), 1);
}
/* lltype -> lltype array */
@@ -425,16 +449,17 @@
Wosize_val(ElementVals));
}
-/* llvalue array -> llvalue */
-CAMLprim LLVMValueRef llvm_const_struct(value ElementVals) {
- return LLVMConstStruct((LLVMValueRef *) Op_val(ElementVals),
- Wosize_val(ElementVals), 0);
+/* llcontext -> llvalue array -> llvalue */
+CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) {
+ return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
+ Wosize_val(ElementVals), 0);
}
-/* llvalue array -> llvalue */
-CAMLprim LLVMValueRef llvm_const_packed_struct(value ElementVals) {
- return LLVMConstStruct((LLVMValueRef *) Op_val(ElementVals),
- Wosize_val(ElementVals), 1);
+/* llcontext -> llvalue array -> llvalue */
+CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C,
+ value ElementVals) {
+ return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
+ Wosize_val(ElementVals), 1);
}
/* llvalue array -> llvalue */
@@ -905,9 +930,9 @@
return V;
}
-/* unit-> llbuilder */
-CAMLprim value llvm_builder(value Unit) {
- return alloc_builder(LLVMCreateBuilder());
+/* llcontext -> llbuilder */
+CAMLprim value llvm_builder(LLVMContextRef C) {
+ return alloc_builder(LLVMCreateBuilderInContext(C));
}
/* (llbasicblock, llvalue) llpos -> llbuilder -> unit */
Modified: llvm/trunk/test/Bindings/Ocaml/analysis.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/analysis.ml?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/analysis.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/analysis.ml Wed Aug 19 01:40:29 2009
@@ -16,9 +16,9 @@
let _ =
let fty = function_type void_type [| |] in
- let m = create_module "valid_m" in
+ let m = create_module (global_context ()) "valid_m" in
let fn = define_function "valid_fn" fty m in
- let at_entry = builder_at_end (entry_block fn) in
+ let at_entry = builder_at_end (global_context ()) (entry_block fn) in
ignore (build_ret_void at_entry);
Modified: llvm/trunk/test/Bindings/Ocaml/bitreader.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/bitreader.ml?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/bitreader.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/bitreader.ml Wed Aug 19 01:40:29 2009
@@ -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 fn = Sys.argv.(1) in
- let m = Llvm.create_module "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);
@@ -22,7 +24,7 @@
begin
let mb = Llvm.MemoryBuffer.of_file fn in
begin try
- let m = Llvm_bitreader.parse_bitcode mb in
+ let m = Llvm_bitreader.parse_bitcode context mb in
Llvm.dispose_module m
with x ->
Llvm.MemoryBuffer.dispose mb;
@@ -43,7 +45,7 @@
begin
let mb = Llvm.MemoryBuffer.of_file fn in
let mp = begin try
- Llvm_bitreader.get_module_provider mb
+ Llvm_bitreader.get_module_provider context mb
with x ->
Llvm.MemoryBuffer.dispose mb;
raise x
@@ -63,7 +65,7 @@
try
let mb = Llvm.MemoryBuffer.of_file fn in
let mp = begin try
- Llvm_bitreader.get_module_provider mb
+ Llvm_bitreader.get_module_provider context mb
with x ->
Llvm.MemoryBuffer.dispose mb;
raise x
Modified: llvm/trunk/test/Bindings/Ocaml/bitwriter.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/bitwriter.ml?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/bitwriter.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/bitwriter.ml Wed Aug 19 01:40:29 2009
@@ -9,7 +9,7 @@
let test x = if not x then exit 1 else ()
let _ =
- let m = Llvm.create_module "ocaml_test_module" in
+ let m = Llvm.create_module (Llvm.global_context ()) "ocaml_test_module" in
ignore (Llvm.define_type_name "caml_int_ty" Llvm.i32_type m);
Modified: llvm/trunk/test/Bindings/Ocaml/executionengine.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/executionengine.ml?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/executionengine.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/executionengine.ml Wed Aug 19 01:40:29 2009
@@ -19,14 +19,14 @@
define_function "main" (function_type i32_type [| i32_type;
str_arr_type;
str_arr_type |]) m in
- let b = builder_at_end (entry_block fn) in
+ let b = builder_at_end (global_context ()) (entry_block fn) in
ignore (build_ret (const_int i32_type retval) b);
fn
let define_plus m =
let fn = define_function "plus" (function_type i32_type [| i32_type;
i32_type |]) m in
- let b = builder_at_end (entry_block fn) in
+ let b = builder_at_end (global_context ()) (entry_block fn) in
let add = build_add (param fn 0) (param fn 1) "sum" b in
ignore (build_ret add b)
@@ -52,10 +52,10 @@
let test_executionengine () =
(* create *)
- let m = create_module "test_module" in
+ let m = create_module (global_context ()) "test_module" in
let main = define_main_fn m 42 in
- let m2 = create_module "test_module2" in
+ let m2 = create_module (global_context ()) "test_module2" in
define_plus m2;
let ee = ExecutionEngine.create (ModuleProvider.create m) in
Modified: llvm/trunk/test/Bindings/Ocaml/scalar_opts.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/scalar_opts.ml?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/scalar_opts.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/scalar_opts.ml Wed Aug 19 01:40:29 2009
@@ -19,7 +19,7 @@
(*===-- Fixture -----------------------------------------------------------===*)
let filename = Sys.argv.(1)
-let m = create_module filename
+let m = create_module (global_context ()) filename
let mp = ModuleProvider.create m
@@ -30,7 +30,7 @@
let fty = function_type void_type [| |] in
let fn = define_function "fn" fty m in
- ignore (build_ret_void (builder_at_end (entry_block fn)));
+ ignore (build_ret_void (builder_at_end (global_context ()) (entry_block fn)));
let td = TargetData.create (target_triple m) in
Modified: llvm/trunk/test/Bindings/Ocaml/target.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/target.ml?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/target.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/target.ml Wed Aug 19 01:40:29 2009
@@ -8,7 +8,6 @@
open Llvm
open Llvm_target
-
(* Tiny unit test framework - really just to help find which line is busted *)
let suite name f =
prerr_endline (name ^ ":");
@@ -18,14 +17,14 @@
(*===-- Fixture -----------------------------------------------------------===*)
let filename = Sys.argv.(1)
-let m = create_module filename
+let m = create_module (global_context ()) filename
(*===-- Target Data -------------------------------------------------------===*)
let test_target_data () =
let td = TargetData.create (target_triple m) in
- let sty = struct_type [| i32_type; i64_type |] in
+ let sty = struct_type (global_context ()) [| i32_type; i64_type |] in
ignore (TargetData.as_string td);
ignore (TargetData.invalidate_struct_layout td sty);
Modified: llvm/trunk/test/Bindings/Ocaml/vmcore.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/vmcore.ml?rev=79410&r1=79409&r2=79410&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/vmcore.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/vmcore.ml Wed Aug 19 01:40:29 2009
@@ -17,6 +17,7 @@
let group_name = ref ""
let case_num = ref 0
let print_checkpoints = false
+let context = global_context ()
let group name =
group_name := !suite_name ^ "/" ^ name;
@@ -47,7 +48,7 @@
(*===-- Fixture -----------------------------------------------------------===*)
let filename = Sys.argv.(1)
-let m = create_module filename
+let m = create_module context filename
let mp = ModuleProvider.create m
@@ -270,20 +271,20 @@
one; two; one; two |] in
ignore (define_global "Const08" c m);
insist ((vector_type i16_type 8) = (type_of c));
-
+
(* RUN: grep {Const09.*.i16 1, i16 2, i32 3, i32 4} < %t.ll
*)
group "structure";
- let c = const_struct [| one; two; three; four |] in
+ let c = const_struct context [| one; two; three; four |] in
ignore (define_global "Const09" c m);
- insist ((struct_type [| i16_type; i16_type; i32_type; i32_type |])
+ insist ((struct_type context [| i16_type; i16_type; i32_type; i32_type |])
= (type_of c));
(* RUN: grep {Const10.*zeroinit} < %t.ll
*)
group "null";
- let c = const_null (packed_struct_type [| i1_type; i8_type;
- i64_type; double_type |]) in
+ let c = const_null (packed_struct_type context [| i1_type; i8_type; i64_type;
+ double_type |]) in
ignore (define_global "Const10" c m);
(* RUN: grep {Const11.*-1} < %t.ll
@@ -496,7 +497,7 @@
insist (is_global_constant g);
begin group "iteration";
- let m = create_module "temp" in
+ let m = create_module context "temp" in
insist (At_end m = global_begin m);
insist (At_start m = global_end m);
@@ -556,7 +557,7 @@
let fn = define_function "Fn3" ty m in
insist (not (is_declaration fn));
insist (1 = Array.length (basic_blocks fn));
- ignore (build_unreachable (builder_at_end (entry_block fn)));
+ ignore (build_unreachable (builder_at_end context (entry_block fn)));
(* RUN: grep {define.*Fn4.*Param1.*Param2} < %t.ll
*)
@@ -570,7 +571,7 @@
insist (i64_type = type_of params.(1));
set_value_name "Param1" params.(0);
set_value_name "Param2" params.(1);
- ignore (build_unreachable (builder_at_end (entry_block fn)));
+ ignore (build_unreachable (builder_at_end context (entry_block fn)));
(* RUN: grep {fastcc.*Fn5} < %t.ll
*)
@@ -579,7 +580,7 @@
insist (CallConv.c = function_call_conv fn);
set_function_call_conv CallConv.fast fn;
insist (CallConv.fast = function_call_conv fn);
- ignore (build_unreachable (builder_at_end (entry_block fn)));
+ ignore (build_unreachable (builder_at_end context (entry_block fn)));
begin group "gc";
(* RUN: grep {Fn6.*gc.*shadowstack} < %t.ll
@@ -591,11 +592,11 @@
set_gc None fn;
insist (None = gc fn);
set_gc (Some "shadowstack") fn;
- ignore (build_unreachable (builder_at_end (entry_block fn)));
+ ignore (build_unreachable (builder_at_end context (entry_block fn)));
end;
begin group "iteration";
- let m = create_module "temp" in
+ let m = create_module context "temp" in
insist (At_end m = function_begin m);
insist (At_start m = function_end m);
@@ -625,7 +626,7 @@
let test_params () =
begin group "iteration";
- let m = create_module "temp" in
+ let m = create_module context "temp" in
let vf = define_function "void" (function_type void_type [| |]) m in
@@ -674,7 +675,7 @@
let fn = declare_function "X" ty m in
let bb = append_block "Bb1" fn in
insist (bb = entry_block fn);
- ignore (build_unreachable (builder_at_end bb));
+ ignore (build_unreachable (builder_at_end context bb));
(* RUN: grep -v Bb2 < %t.ll
*)
@@ -688,15 +689,15 @@
let bbb = append_block "b" fn in
let bba = insert_block "a" bbb in
insist ([| bba; bbb |] = basic_blocks fn);
- ignore (build_unreachable (builder_at_end bba));
- ignore (build_unreachable (builder_at_end bbb));
+ ignore (build_unreachable (builder_at_end context bba));
+ ignore (build_unreachable (builder_at_end context bbb));
(* RUN: grep Bb3 < %t.ll
*)
group "name/value";
let fn = define_function "X4" ty m in
let bb = entry_block fn in
- ignore (build_unreachable (builder_at_end bb));
+ ignore (build_unreachable (builder_at_end context bb));
let bbv = value_of_block bb in
set_value_name "Bb3" bbv;
insist ("Bb3" = value_name bbv);
@@ -704,13 +705,13 @@
group "casts";
let fn = define_function "X5" ty m in
let bb = entry_block fn in
- ignore (build_unreachable (builder_at_end bb));
+ ignore (build_unreachable (builder_at_end context bb));
insist (bb = block_of_value (value_of_block bb));
insist (value_is_block (value_of_block bb));
insist (not (value_is_block (const_null i32_type)));
begin group "iteration";
- let m = create_module "temp" in
+ let m = create_module context "temp" in
let f = declare_function "Temp" (function_type i32_type [| |]) m in
insist (At_end f = block_begin f);
@@ -741,11 +742,11 @@
let test_instructions () =
begin group "iteration";
- let m = create_module "temp" in
+ let m = create_module context "temp" in
let fty = function_type void_type [| i32_type; i32_type |] in
let f = define_function "f" fty m in
let bb = entry_block f in
- let b = builder_at (At_end bb) in
+ let b = builder_at context (At_end bb) in
insist (At_end bb = instr_begin bb);
insist (At_start bb = instr_end bb);
@@ -778,7 +779,7 @@
begin group "parent";
insist (try
- ignore (insertion_block (builder ()));
+ ignore (insertion_block (builder context));
false
with Not_found ->
true);
@@ -786,7 +787,7 @@
let fty = function_type void_type [| i32_type |] in
let fn = define_function "BuilderParent" fty m in
let bb = entry_block fn in
- let b = builder_at_end bb in
+ let b = builder_at_end context bb in
let p = param fn 0 in
let sum = build_add p p "sum" b in
ignore (build_ret_void b);
@@ -803,21 +804,21 @@
*)
let fty = function_type void_type [| |] in
let fn = declare_function "X6" fty m in
- let b = builder_at_end (append_block "Bb01" fn) in
+ let b = builder_at_end context (append_block "Bb01" fn) in
ignore (build_ret_void b)
end;
(* The rest of the tests will use one big function. *)
let fty = function_type i32_type [| i32_type; i32_type |] in
let fn = define_function "X7" fty m in
- let atentry = builder_at_end (entry_block fn) in
+ let atentry = builder_at_end context (entry_block fn) in
let p1 = param fn 0 ++ set_value_name "P1" in
let p2 = param fn 1 ++ set_value_name "P2" in
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
- ignore (build_unreachable (builder_at_end bb00));
+ ignore (build_unreachable (builder_at_end context bb00));
group "ret"; begin
(* RUN: grep {ret.*P1} < %t.ll
@@ -830,7 +831,7 @@
(* RUN: grep {br.*Bb02} < %t.ll
*)
let bb02 = append_block "Bb02" fn in
- let b = builder_at_end bb02 in
+ let b = builder_at_end context bb02 in
ignore (build_br bb02 b)
end;
@@ -838,7 +839,7 @@
(* RUN: grep {br.*Inst01.*Bb03.*Bb00} < %t.ll
*)
let bb03 = append_block "Bb03" fn in
- let b = builder_at_end bb03 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)
end;
@@ -849,10 +850,10 @@
*)
let bb1 = append_block "SwiBlock1" fn in
let bb2 = append_block "SwiBlock2" fn in
- ignore (build_unreachable (builder_at_end bb2));
+ ignore (build_unreachable (builder_at_end context bb2));
let bb3 = append_block "SwiBlock3" fn in
- ignore (build_unreachable (builder_at_end bb3));
- let si = build_switch p1 bb3 1 (builder_at_end bb1) 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)
end;
@@ -861,7 +862,7 @@
* RUN: grep {to.*Bb04.*unwind.*Bb00} < %t.ll
*)
let bb04 = append_block "Bb04" fn in
- let b = builder_at_end bb04 in
+ let b = builder_at_end context bb04 in
ignore (build_invoke fn [| p1; p2 |] bb04 bb00 "Inst02" b)
end;
@@ -869,7 +870,7 @@
(* RUN: grep {unwind} < %t.ll
*)
let bb05 = append_block "Bb05" fn in
- let b = builder_at_end bb05 in
+ let b = builder_at_end context bb05 in
ignore (build_unwind b)
end;
@@ -877,13 +878,13 @@
(* RUN: grep {unreachable} < %t.ll
*)
let bb06 = append_block "Bb06" fn in
- let b = builder_at_end bb06 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 b = builder_at_end bb07 in
+ let b = builder_at_end context bb07 in
(* RUN: grep {Inst03.*add.*P1.*P2} < %t.ll
* RUN: grep {Inst04.*sub.*P1.*Inst03} < %t.ll
@@ -925,7 +926,7 @@
group "memory"; begin
let bb08 = append_block "Bb08" fn in
- let b = builder_at_end bb08 in
+ let b = builder_at_end context bb08 in
(* RUN: grep {Inst20.*malloc.*i8 } < %t.ll
* RUN: grep {Inst21.*malloc.*i8.*P1} < %t.ll
@@ -1037,9 +1038,9 @@
let b2 = append_block "PhiBlock2" fn in
let jb = append_block "PhiJoinBlock" fn in
- ignore (build_br jb (builder_at_end b1));
- ignore (build_br jb (builder_at_end b2));
- let at_jb = builder_at_end jb 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
let phi = build_phi [(p1, b1)] "PhiNode" at_jb in
insist ([(p1, b1)] = incoming phi);
@@ -1054,7 +1055,7 @@
(*===-- Module Provider ---------------------------------------------------===*)
let test_module_provider () =
- let m = create_module "test" in
+ let m = create_module context "test" in
let mp = ModuleProvider.create m in
ModuleProvider.dispose mp
@@ -1073,7 +1074,7 @@
begin group "function pass manager";
let fty = function_type void_type [| |] in
let fn = define_function "FunctionPassManager" fty m in
- ignore (build_ret_void (builder_at_end (entry_block fn)));
+ ignore (build_ret_void (builder_at_end context (entry_block fn)));
ignore (PassManager.create_function mp
++ PassManager.initialize
More information about the llvm-commits
mailing list