diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 7786d8c48d4..e335eb8d39d 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -820,6 +820,9 @@ external add_destination : llvalue -> llbasicblock -> unit 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 24621486f4b..ef7c986e91c 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -339,7 +339,7 @@ val ppc_fp128_type : llcontext -> lltype 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 add_destination : llvalue -> llbasicblock -> unit 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 4baf99b4b16..1c1a526fd71 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -1212,6 +1212,19 @@ CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) { 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 fa60398044e..d65bf37a6c6 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -834,7 +834,17 @@ let test_builder () = 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 @@ let test_builder () = 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