attempt to fix ocaml bindings: landing pads

llvm-svn: 140991

llvm/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 .........................................................--*)

llvm/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]

llvm/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));

llvm/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