[llvm-commits] [llvm] r140991 - in /llvm/trunk: bindings/ocaml/llvm/llvm.ml bindings/ocaml/llvm/llvm.mli bindings/ocaml/llvm/llvm_ocaml.c test/Bindings/Ocaml/vmcore.ml

[Torok Edwin]

Author: edwin
Date: Mon Oct  3 01:41:46 2011
New Revision: 140991

URL: http://llvm.org/viewvc/llvm-project?rev=140991&view=rev
Log:
attempt to fix ocaml bindings: landing pads

Modified:
    llvm/trunk/bindings/ocaml/llvm/llvm.ml
    llvm/trunk/bindings/ocaml/llvm/llvm.mli
    llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
    llvm/trunk/test/Bindings/Ocaml/vmcore.ml

Modified: llvm/trunk/bindings/ocaml/llvm/llvm.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.ml?rev=140991&r1=140990&r2=140991&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Mon Oct  3 01:41:46 2011
@@ -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 .........................................................--*)

Modified: llvm/trunk/bindings/ocaml/llvm/llvm.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.mli?rev=140991&r1=140990&r2=140991&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.mli (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.mli Mon Oct  3 01:41:46 2011
@@ -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]

Modified: llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c?rev=140991&r1=140990&r2=140991&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c Mon Oct  3 01:41:46 2011
@@ -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));

Modified: llvm/trunk/test/Bindings/Ocaml/vmcore.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/vmcore.ml?rev=140991&r1=140990&r2=140991&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/vmcore.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/vmcore.ml Mon Oct  3 01:41:46 2011
@@ -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