From a156efdf71bc668093e31593713694cf076db895 Mon Sep 17 00:00:00 2001 From: Torok Edwin Date: Thu, 23 Dec 2010 15:49:26 +0000 Subject: Fix OCaml bindings crash, PR8847. See http://caml.inria.fr/mantis/view.php?id=4166 If we call only external functions from a module, then its 'let _' bindings don't get executed, which means that the exceptions don't get registered for use in the C code. This in turn causes llvm_raise to call raise_with_arg() with a NULL pointer and cause a segmentation fault. The workaround is to declare all 'external' functions as 'val' in these .mli files. Also added a separate testcase (the testcase must call only external functions for the bug to occur). git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@122497 91177308-0d34-0410-b5e6-96231b3b80d8 --- .../ocaml/executionengine/llvm_executionengine.mli | 68 +++++++++++----------- 1 file changed, 34 insertions(+), 34 deletions(-) (limited to 'bindings/ocaml/executionengine/llvm_executionengine.mli') diff --git a/bindings/ocaml/executionengine/llvm_executionengine.mli b/bindings/ocaml/executionengine/llvm_executionengine.mli index ce25f9d0ae..166b7bcddc 100644 --- a/bindings/ocaml/executionengine/llvm_executionengine.mli +++ b/bindings/ocaml/executionengine/llvm_executionengine.mli @@ -25,58 +25,58 @@ module GenericValue: sig (** [of_float fpty n] boxes the float [n] in a float-valued generic value according to the floating point type [fpty]. See the fields [llvm::GenericValue::DoubleVal] and [llvm::GenericValue::FloatVal]. *) - external of_float : Llvm.lltype -> float -> t = "llvm_genericvalue_of_float" + val of_float : Llvm.lltype -> float -> t (** [of_pointer v] boxes the pointer value [v] in a generic value. See the field [llvm::GenericValue::PointerVal]. *) - external of_pointer : 'a -> t = "llvm_genericvalue_of_pointer" + val of_pointer : 'a -> t (** [of_int32 n w] boxes the int32 [i] in a generic value with the bitwidth [w]. See the field [llvm::GenericValue::IntVal]. *) - external of_int32 : Llvm.lltype -> int32 -> t = "llvm_genericvalue_of_int32" + val of_int32 : Llvm.lltype -> int32 -> t (** [of_int n w] boxes the int [i] in a generic value with the bitwidth [w]. See the field [llvm::GenericValue::IntVal]. *) - external of_int : Llvm.lltype -> int -> t = "llvm_genericvalue_of_int" + val of_int : Llvm.lltype -> int -> t (** [of_natint n w] boxes the native int [i] in a generic value with the bitwidth [w]. See the field [llvm::GenericValue::IntVal]. *) - external of_nativeint : Llvm.lltype -> nativeint -> t - = "llvm_genericvalue_of_nativeint" + val of_nativeint : Llvm.lltype -> nativeint -> t + (** [of_int64 n w] boxes the int64 [i] in a generic value with the bitwidth [w]. See the field [llvm::GenericValue::IntVal]. *) - external of_int64 : Llvm.lltype -> int64 -> t = "llvm_genericvalue_of_int64" + val of_int64 : Llvm.lltype -> int64 -> t (** [as_float fpty gv] unboxes the floating point-valued generic value [gv] of floating point type [fpty]. See the fields [llvm::GenericValue::DoubleVal] and [llvm::GenericValue::FloatVal]. *) - external as_float : Llvm.lltype -> t -> float = "llvm_genericvalue_as_float" + val as_float : Llvm.lltype -> t -> float (** [as_pointer gv] unboxes the pointer-valued generic value [gv]. See the field [llvm::GenericValue::PointerVal]. *) - external as_pointer : t -> 'a = "llvm_genericvalue_as_pointer" + val as_pointer : t -> 'a (** [as_int32 gv] unboxes the integer-valued generic value [gv] as an [int32]. Is invalid if [gv] has a bitwidth greater than 32 bits. See the field [llvm::GenericValue::IntVal]. *) - external as_int32 : t -> int32 = "llvm_genericvalue_as_int32" + val as_int32 : t -> int32 (** [as_int gv] unboxes the integer-valued generic value [gv] as an [int]. Is invalid if [gv] has a bitwidth greater than the host bit width (but the most significant bit may be lost). See the field [llvm::GenericValue::IntVal]. *) - external as_int : t -> int = "llvm_genericvalue_as_int" + val as_int : t -> int (** [as_natint gv] unboxes the integer-valued generic value [gv] as a [nativeint]. Is invalid if [gv] has a bitwidth greater than [nativeint]. See the field [llvm::GenericValue::IntVal]. *) - external as_nativeint : t -> nativeint = "llvm_genericvalue_as_nativeint" + val as_nativeint : t -> nativeint (** [as_int64 gv] returns the integer-valued generic value [gv] as an [int64]. Is invalid if [gv] has a bitwidth greater than [int64]. See the field [llvm::GenericValue::IntVal]. *) - external as_int64 : t -> int64 = "llvm_genericvalue_as_int64" + val as_int64 : t -> int64 end @@ -91,73 +91,73 @@ module ExecutionEngine: sig interpreter. Raises [Error msg] if an error occurrs. The execution engine is not garbage collected and must be destroyed with [dispose ee]. See the function [llvm::EngineBuilder::create]. *) - external create : Llvm.llmodule -> t = "llvm_ee_create" + val create : Llvm.llmodule -> t (** [create_interpreter m] creates a new interpreter, taking ownership of the module [m] if successful. Raises [Error msg] if an error occurrs. The execution engine is not garbage collected and must be destroyed with [dispose ee]. See the function [llvm::EngineBuilder::create]. *) - external create_interpreter : Llvm.llmodule -> t = "llvm_ee_create_interpreter" + val create_interpreter : Llvm.llmodule -> t (** [create_jit m optlevel] creates a new JIT (just-in-time compiler), taking ownership of the module [m] if successful with the desired optimization level [optlevel]. Raises [Error msg] if an error occurrs. The execution engine is not garbage collected and must be destroyed with [dispose ee]. See the function [llvm::EngineBuilder::create]. *) - external create_jit : Llvm.llmodule -> int -> t = "llvm_ee_create_jit" + val create_jit : Llvm.llmodule -> int -> t (** [dispose ee] releases the memory used by the execution engine and must be invoked to avoid memory leaks. *) - external dispose : t -> unit = "llvm_ee_dispose" + val dispose : t -> unit (** [add_module m ee] adds the module [m] to the execution engine [ee]. *) - external add_module : Llvm.llmodule -> t -> unit = "llvm_ee_add_module" + val add_module : Llvm.llmodule -> t -> unit (** [remove_module m ee] removes the module [m] from the execution engine [ee], disposing of [m] and the module referenced by [mp]. Raises [Error msg] if an error occurs. *) - external remove_module : Llvm.llmodule -> t -> Llvm.llmodule - = "llvm_ee_remove_module" + val remove_module : Llvm.llmodule -> t -> Llvm.llmodule + (** [find_function n ee] finds the function named [n] defined in any of the modules owned by the execution engine [ee]. Returns [None] if the function is not found and [Some f] otherwise. *) - external find_function : string -> t -> Llvm.llvalue option - = "llvm_ee_find_function" + val find_function : string -> t -> Llvm.llvalue option + (** [run_function f args ee] synchronously executes the function [f] with the arguments [args], which must be compatible with the parameter types. *) - external run_function : Llvm.llvalue -> GenericValue.t array -> t -> + val run_function : Llvm.llvalue -> GenericValue.t array -> t -> GenericValue.t - = "llvm_ee_run_function" + (** [run_static_ctors ee] executes the static constructors of each module in the execution engine [ee]. *) - external run_static_ctors : t -> unit = "llvm_ee_run_static_ctors" + val run_static_ctors : t -> unit (** [run_static_dtors ee] executes the static destructors of each module in the execution engine [ee]. *) - external run_static_dtors : t -> unit = "llvm_ee_run_static_dtors" + val run_static_dtors : t -> unit (** [run_function_as_main f args env ee] executes the function [f] as a main function, passing it [argv] and [argc] according to the string array [args], and [envp] as specified by the array [env]. Returns the integer return value of the function. *) - external run_function_as_main : Llvm.llvalue -> string array -> + val run_function_as_main : Llvm.llvalue -> string array -> (string * string) array -> t -> int - = "llvm_ee_run_function_as_main" + (** [free_machine_code f ee] releases the memory in the execution engine [ee] used to store the machine code for the function [f]. *) - external free_machine_code : Llvm.llvalue -> t -> unit - = "llvm_ee_free_machine_code" + val free_machine_code : Llvm.llvalue -> t -> unit + (** [target_data ee] is the target data owned by the execution engine [ee]. *) - external target_data : t -> Llvm_target.TargetData.t - = "LLVMGetExecutionEngineTargetData" + val target_data : t -> Llvm_target.TargetData.t + end -external initialize_native_target : unit -> bool - = "llvm_initialize_native_target" +val initialize_native_target : unit -> bool + -- cgit v1.2.3