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 7786d8c48d45f6a4d68d1ec9605d08f11677b4f2..e335eb8d39dddf92bd52e1e4db60337991d0e79a 100644 (file)
--- 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_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 .........................................................--*)
 external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable"
 
 (*--... Arithmetic .........................................................--*)

diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 24621486f4b05b2b145c66d45a64e7f86de1702b..ef7c986e91ca778a1455312b3e7856e0db1f8699 100644 (file)
--- 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
 
     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]. *)
     [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
 
 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]
 
 (** [build_unreachable b] creates an
     [unreachable]

diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 4baf99b4b16b931294fa5f35343f7be3ec9465bc..1c1a526fd71a0522beb38aab10246564151b5ab4 100644 (file)
--- 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]);
 }
 
                                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));
 /* 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 fa60398044e368b662955114a5bb083e4468b3be..d65bf37a6c6deb0ded2a5b77245406152ec6ae4c 100644 (file)
--- 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 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
      *)
   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
   
   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
      *)
     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
   end;
   
   group "unreachable"; begin