C and Objective Caml bindings for PHINode::addIncoming etc.

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@42760 91177308-0d34-0410-b5e6-96231b3b80d8

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 779066bddc14f2126b954fd321bb5a71793bb16d..e19228afac21d14202787200522b6f3624da98ff 100644 (file)
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -314,6 +314,11 @@ external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
 external value_is_block : llvalue -> bool = "llvm_value_is_block"
 external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
 
+(*--... Operations on phi nodes ............................................--*)
+external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
+                      = "llvm_add_incoming"
+external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
+
 
 (*===-- Instruction builders ----------------------------------------------===*)
 external builder_before : llvalue -> llbuilder = "llvm_builder_before"
@@ -422,7 +427,8 @@ external build_fcmp : real_predicate -> llvalue -> llvalue -> string ->
                       llbuilder -> llvalue = "llvm_build_fcmp"
 
 (*--... Miscellaneous instructions .........................................--*)
-external build_phi : lltype -> string -> llbuilder -> llvalue = "llvm_build_phi"
+external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder ->
+                     llvalue = "llvm_build_phi"
 external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
                     = "llvm_build_call"
 external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder ->

diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 5e55b200b176b674012aa78f62a4656d46256096..abb90f24c8c5156ca34de4e4982cc953e93b0df6 100644 (file)
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -295,6 +295,11 @@ external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
 external value_is_block : llvalue -> bool = "llvm_value_is_block"
 external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
 
+(*--... Operations on phi nodes ............................................--*)
+external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
+                      = "llvm_add_incoming"
+external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
+
 
 (*===-- Instruction builders ----------------------------------------------===*)
 external builder_before : llvalue -> llbuilder = "llvm_builder_before"
@@ -403,7 +408,8 @@ external build_fcmp : real_predicate -> llvalue -> llvalue -> string ->
                       llbuilder -> llvalue = "llvm_build_fcmp"
 
 (*--... Miscellaneous instructions .........................................--*)
-external build_phi : lltype -> string -> llbuilder -> llvalue = "llvm_build_phi"
+external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder ->
+                     llvalue = "llvm_build_phi"
 external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
                     = "llvm_build_call"
 external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder ->

diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 98354fc84cdb6b4f89a5a72e1eb0a51cdecd830d..ddf577adb295dfebb6a1f4b962a19b3ed91d3065 100644 (file)
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -21,6 +21,7 @@
 #include "caml/mlvalues.h"
 #include "caml/memory.h"
 #include "llvm/Config/config.h"
+#include <assert.h>
 
 
 /*===-- Modules -----------------------------------------------------------===*/
@@ -572,6 +573,39 @@ CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
   return Val_bool(LLVMValueIsBasicBlock(Val));
 }
 
+/*--... Operations on phi nodes ............................................--*/
+
+/* (llvalue * llbasicblock) -> llvalue -> unit */
+CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
+  LLVMAddIncoming(PhiNode,
+                  (LLVMValueRef*) &Field(Incoming, 0),
+                  (LLVMBasicBlockRef*) &Field(Incoming, 1),
+                  1);
+  return Val_unit;
+}
+
+/* llvalue -> (llvalue * llbasicblock) list */
+CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
+  unsigned I;
+  CAMLparam0();
+  CAMLlocal3(Hd, Tl, Tmp);
+  
+  /* Build a tuple list of them. */
+  Tl = Val_int(0);
+  for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
+    Hd = alloc(2, 0);
+    Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
+    Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
+    
+    Tmp = alloc(2, 0);
+    Store_field(Tmp, 0, Hd);
+    Store_field(Tmp, 1, Tl);
+    Tl = Tmp;
+  }
+  
+  CAMLreturn(Tl);
+}
+
 
 /*===-- Instruction builders ----------------------------------------------===*/
 
@@ -933,10 +967,25 @@ CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
 
 /*--... Miscellaneous instructions .........................................--*/
 
-/* lltype -> string -> llbuilder -> llvalue */
-CAMLprim LLVMValueRef llvm_build_phi(LLVMTypeRef Ty,
-                                     value Name, value B) {
-  return LLVMBuildPhi(Builder_val(B), Ty, String_val(Name));
+/* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
+  value Hd, Tl;
+  LLVMValueRef FirstValue, PhiNode;
+  
+  assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
+  
+  Hd = Field(Incoming, 0);
+  FirstValue = (LLVMValueRef) Field(Hd, 0);
+  PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
+                         String_val(Name));
+
+  for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) {
+    value Hd = Field(Tl, 0);
+    LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
+                    (LLVMBasicBlockRef*) &Field(Hd, 1), 1);
+  }
+  
+  return PhiNode;
 }
 
 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */

diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h
index d8bff3211a3ae539c488b6fe188234b1b6a58794..a9228bcfc300b394f2cb51eff6f447cb4fe9da31 100644 (file)
--- a/include/llvm-c/Core.h
+++ b/include/llvm-c/Core.h
@@ -352,6 +352,12 @@ LLVMBasicBlockRef LLVMInsertBasicBlock(LLVMBasicBlockRef InsertBeforeBB,
                                        const char *Name);
 void LLVMDeleteBasicBlock(LLVMBasicBlockRef BB);
 
+/* Operations on phi nodes */
+void LLVMAddIncoming(LLVMValueRef PhiNode, LLVMValueRef *IncomingValues,
+                     LLVMBasicBlockRef *IncomingBlocks, unsigned Count);
+unsigned LLVMCountIncoming(LLVMValueRef PhiNode);
+LLVMValueRef LLVMGetIncomingValue(LLVMValueRef PhiNode, unsigned Index);
+LLVMBasicBlockRef LLVMGetIncomingBlock(LLVMValueRef PhiNode, unsigned Index);
 
 /*===-- Instruction builders ----------------------------------------------===*/
 

diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp
index 34a0e13a2bee64f85c4538843e0001d2a3f01aa5..61ff6a8c00d66747eca9996cb36a833beca68504 100644 (file)
--- a/lib/VMCore/Core.cpp
+++ b/lib/VMCore/Core.cpp
@@ -562,7 +562,6 @@ void LLVMSetThreadLocal(LLVMValueRef GlobalVar, int IsThreadLocal) {
 }
 
 int LLVMIsGlobalConstant(LLVMValueRef GlobalVar) {
-  bool res = unwrap<GlobalVariable>(GlobalVar)->isConstant();
   return unwrap<GlobalVariable>(GlobalVar)->isConstant();
 }
 
@@ -684,6 +683,27 @@ void LLVMSetInstructionCallConv(LLVMValueRef Instr, unsigned CC) {
   assert(0 && "LLVMSetInstructionCallConv applies only to call and invoke!");
 }
 
+/*--.. Operations on phi nodes .............................................--*/
+
+void LLVMAddIncoming(LLVMValueRef PhiNode, LLVMValueRef *IncomingValues,
+                     LLVMBasicBlockRef *IncomingBlocks, unsigned Count) {
+  PHINode *PhiVal = unwrap<PHINode>(PhiNode);
+  for (unsigned I = 0; I != Count; ++I)
+    PhiVal->addIncoming(unwrap(IncomingValues[I]), unwrap(IncomingBlocks[I]));
+}
+
+unsigned LLVMCountIncoming(LLVMValueRef PhiNode) {
+  return unwrap<PHINode>(PhiNode)->getNumIncomingValues();
+}
+
+LLVMValueRef LLVMGetIncomingValue(LLVMValueRef PhiNode, unsigned Index) {
+  return wrap(unwrap<PHINode>(PhiNode)->getIncomingValue(Index));
+}
+
+LLVMBasicBlockRef LLVMGetIncomingBlock(LLVMValueRef PhiNode, unsigned Index) {
+  return wrap(unwrap<PHINode>(PhiNode)->getIncomingBlock(Index));
+}
+
 
 /*===-- Instruction builders ----------------------------------------------===*/
 

diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index 4280b1c9f3703940ac75be865b108a3fbe80eb27..5c24992929a64721e3d3b5dbb4523ff8ff680bbb 100644 (file)
--- a/test/Bindings/Ocaml/vmcore.ml
+++ b/test/Bindings/Ocaml/vmcore.ml
@@ -1,4 +1,4 @@
-(* RUN: %ocamlc llvm.cma llvm_bitwriter.cma %s -o %t
+(* RUN: %ocamlc llvm.cma llvm_analysis.cma llvm_bitwriter.cma %s -o %t
  * RUN: ./%t %t.bc
  * RUN: llvm-dis < %t.bc > %t.ll
  *)
@@ -467,7 +467,7 @@ let test_functions () =
   let fn = define_function "Fn3" ty m in
   insist (not (is_declaration fn));
   insist (1 = Array.length (basic_blocks fn));
-  (* this function is not valid because init bb lacks a terminator *)
+  ignore (build_unreachable (builder_at_end (entry_block fn)));
   
   (* RUN: grep {define.*Fn4.*Param1.*Param2} < %t.ll
    *)
@@ -481,7 +481,7 @@ let test_functions () =
   insist (i64_type = type_of params.(1));
   set_value_name "Param1" params.(0);
   set_value_name "Param2" params.(1);
-  (* this function is not valid because init bb lacks a terminator *)
+  ignore (build_unreachable (builder_at_end (entry_block fn)));
   
   (* RUN: grep {fastcc.*Fn5} < %t.ll
    *)
@@ -489,7 +489,8 @@ let test_functions () =
   let fn = define_function "Fn5" ty m in
   insist (ccc = function_call_conv fn);
   set_function_call_conv fastcc fn;
-  insist (fastcc = function_call_conv fn)
+  insist (fastcc = function_call_conv fn);
+  ignore (build_unreachable (builder_at_end (entry_block fn)))
 
 
 (*===-- Basic Blocks ------------------------------------------------------===*)
@@ -503,6 +504,7 @@ let test_basic_blocks () =
   let fn = declare_function "X" ty m in
   let bb = append_block "Bb1" fn in
   insist (bb = entry_block fn);
+  ignore (build_unreachable (builder_at_end bb));
   
   (* RUN: grep -v Bb2 < %t.ll
    *)
@@ -513,15 +515,18 @@ let test_basic_blocks () =
   
   group "insert";
   let fn = declare_function "X3" ty m in
-  let bbb = append_block "" fn in
-  let bba = insert_block "" bbb in
+  let bbb = append_block "b" fn in
+  let bba = insert_block "a" bbb in
   insist ([| bba; bbb |] = basic_blocks fn);
+  ignore (build_unreachable (builder_at_end bba));
+  ignore (build_unreachable (builder_at_end bbb));
   
   (* RUN: grep Bb3 < %t.ll
    *)
   group "name/value";
   let fn = define_function "X4" ty m in
   let bb = entry_block fn in
+  ignore (build_unreachable (builder_at_end bb));
   let bbv = value_of_block bb in
   set_value_name "Bb3" bbv;
   insist ("Bb3" = value_name bbv);
@@ -529,6 +534,7 @@ let test_basic_blocks () =
   group "casts";
   let fn = define_function "X5" ty m in
   let bb = entry_block fn in
+  ignore (build_unreachable (builder_at_end bb));
   insist (bb = block_of_value (value_of_block bb));
   insist (value_is_block (value_of_block bb));
   insist (not (value_is_block (const_null i32_type)))
@@ -650,7 +656,8 @@ let test_builder () =
     let inst16 = build_or   p1 inst15 "Inst16" b in
     let inst17 = build_xor  p1 inst16 "Inst17" b in
     let inst18 = build_neg  inst17    "Inst18" b in
-         ignore (build_not  inst18    "Inst19" b)
+         ignore (build_not  inst18    "Inst19" b);
+         ignore (build_unreachable b)
   end;
   
   group "memory"; begin
@@ -673,7 +680,8 @@ let test_builder () =
           ignore(build_free inst20 b);
           ignore(build_load inst21 "Inst25" b);
           ignore(build_store p2 inst22 b);
-          ignore(build_gep inst23 [| p2 |] "Inst27" b)
+          ignore(build_gep inst23 [| p2 |] "Inst27" b);
+          ignore(build_unreachable b)
   end;
   
   group "casts"; begin
@@ -724,11 +732,8 @@ let test_builder () =
      * RUN: grep {Inst48.*va_arg.*null.*i32} < %t.ll
      * RUN: grep {Inst49.*extractelement.*Vec1.*P2} < %t.ll
      * RUN: grep {Inst50.*insertelement.*Vec1.*P1.*P2} < %t.ll
-     * RUN: grep {Inst51.*shufflevector.*Vec1.*Vec2.*Vec3} < %t.ll
+     * RUN: grep {Inst51.*shufflevector.*Vec1.*Vec2.*1.*1.*0.*0} < %t.ll
      *)
-    
-    (* TODO: %Inst44 = Phi *)
-    
          ignore (build_call fn [| p2; p1 |] "Inst45" atentry);
     let inst46 = build_icmp Icmp_eq p1 p2 "Inst46" atentry in
          ignore (build_select inst46 p1 p2 "Inst47" atentry);
@@ -737,8 +742,8 @@ let test_builder () =
                   i32_type "Inst48" atentry);
     
     (* Set up some vector vregs. *)
-    let one = const_int i32_type (-1) in
-    let zero = const_int i32_type 1 in
+    let one  = const_int i32_type 1 in
+    let zero = const_int i32_type 0 in
     let t1 = const_vector [| one; zero; one; zero |] in
     let t2 = const_vector [| zero; one; zero; one |] in
     let t3 = const_vector [| one; one; zero; zero |] in
@@ -748,13 +753,38 @@ let test_builder () =
     
     ignore (build_extractelement vec1 p2 "Inst49" atentry);
     ignore (build_insertelement vec1 p1 p2 "Inst50" atentry);
-    ignore (build_shufflevector vec1 vec2 vec3 "Inst51" atentry);
+    ignore (build_shufflevector vec1 vec2 t3 "Inst51" atentry);
+  end;
+  
+  group "phi"; begin
+    (* RUN: grep {PhiNode.*P1.*PhiBlock1.*P2.*PhiBlock2} < %t.ll
+     *)
+    let b1 = append_block "PhiBlock1" fn in
+    let b2 = append_block "PhiBlock2" fn in
+    
+    let jb = append_block "PhiJoinBlock" fn in
+    ignore (build_br jb (builder_at_end b1));
+    ignore (build_br jb (builder_at_end b2));
+    let at_jb = builder_at_end jb in
+    
+    let phi = build_phi [(p1, b1)] "PhiNode" at_jb in
+    insist ([(p1, b1)] = incoming phi);
+    
+    add_incoming (p2, b2) phi;
+    insist ([(p1, b1); (p2, b2)] = incoming phi);
+    
+    ignore (build_unreachable at_jb);
   end
 
 
 (*===-- Writer ------------------------------------------------------------===*)
 
 let test_writer () =
+  group "valid";
+  insist (match Llvm_analysis.verify_module m with
+          | None -> true
+          | Some msg -> prerr_string msg; false);
+
   group "writer";
   insist (write_bitcode_file m filename);