attempt to fix ocaml bindings: landing pads
git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@140991 91177308-0d34-0410-b5e6-96231b3b80d8
diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 7786d8c..e335eb8 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -820,6 +820,9 @@
external build_invoke : llvalue -> llvalue array -> llbasicblock ->
llbasicblock -> string -> llbuilder -> llvalue
= "llvm_build_invoke_bc" "llvm_build_invoke_nat"
+external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
+ llvalue = "llvm_build_landingpad"
+external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup"
external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable"
(*--... Arithmetic .........................................................--*)
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 2462148..ef7c986 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -339,7 +339,7 @@
See the method [llvm::FunctionType::get]. *)
val function_type : lltype -> lltype array -> lltype
-(** [va_arg_function_type ret_ty param_tys] is just like
+(** [var_arg_function_type ret_ty param_tys] is just like
[function_type ret_ty param_tys] except that it returns the function type
which also takes a variable number of arguments.
See the method [llvm::FunctionType::get]. *)
@@ -1615,6 +1615,16 @@
val build_invoke : llvalue -> llvalue array -> llbasicblock ->
llbasicblock -> string -> llbuilder -> llvalue
+(** [build_landingpad ty persfn numclauses name b] creates an
+ [landingpad]
+ instruction at the position specified by the instruction builder [b].
+ See the method [llvm::LLVMBuilder::CreateLandingPad]. *)
+val build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
+ llvalue
+
+(** [set_cleanup lp] sets the cleanup flag in the [landingpad]instruction.
+ See the method [llvm::LandingPadInst::setCleanup]. *)
+val set_cleanup : llvalue -> bool -> unit
(** [build_unreachable b] creates an
[unreachable]
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 4baf99b..1c1a526 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -1212,6 +1212,19 @@
Args[4], Args[5]);
}
+CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
+ value NumClauses, value Name,
+ value B) {
+ return LLVMBuildLandingPad(Builder_val(B), Ty, PersFn, Int_val(NumClauses),
+ String_val(Name));
+}
+
+CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
+{
+ LLVMSetCleanup(LandingPadInst, Bool_val(flag));
+ return Val_unit;
+}
+
/* llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
return LLVMBuildUnreachable(Builder_val(B));
diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index fa60398..d65bf37 100644
--- a/test/Bindings/Ocaml/vmcore.ml
+++ b/test/Bindings/Ocaml/vmcore.ml
@@ -834,7 +834,17 @@
let bb00 = append_block context "Bb00" fn in
ignore (build_unreachable (builder_at_end context bb00));
-
+
+ let bblpad = append_block context "Bblpad" fn in
+ let rt = struct_type context [| pointer_type i8_type; i32_type |] in
+ let ft = var_arg_function_type i32_type [||] in
+ let personality = declare_function "__gxx_personality_v0" ft m in begin
+ let lp = build_landingpad rt personality 0 "lpad"
+ (builder_at_end context bblpad) in
+ set_cleanup lp true;
+ ignore (build_unreachable (builder_at_end context bblpad));
+ end;
+
group "ret"; begin
(* RUN: grep {ret.*P1} < %t.ll
*)
@@ -891,11 +901,11 @@
group "invoke"; begin
(* RUN: grep {build_invoke.*invoke.*P1.*P2} < %t.ll
- * RUN: grep {to.*Bb04.*unwind.*Bb00} < %t.ll
+ * RUN: grep {to.*Bb04.*unwind.*Bblpad} < %t.ll
*)
let bb04 = append_block context "Bb04" fn in
let b = builder_at_end context bb04 in
- ignore (build_invoke fn [| p1; p2 |] bb04 bb00 "build_invoke" b)
+ ignore (build_invoke fn [| p1; p2 |] bb04 bblpad "build_invoke" b)
end;
group "unreachable"; begin
