[llvm-commits] [llvm] r42760 - in /llvm/trunk: bindings/ocaml/llvm/llvm.ml bindings/ocaml/llvm/llvm.mli bindings/ocaml/llvm/llvm_ocaml.c include/llvm-c/Core.h lib/VMCore/Core.cpp test/Bindings/Ocaml/vmcore.ml
Gordon Henriksen
gordonhenriksen at mac.com
Mon Oct 8 11:14:40 PDT 2007
Author: gordon
Date: Mon Oct 8 13:14:39 2007
New Revision: 42760
URL: http://llvm.org/viewvc/llvm-project?rev=42760&view=rev
Log:
C and Objective Caml bindings for PHINode::addIncoming etc.
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/include/llvm-c/Core.h
llvm/trunk/lib/VMCore/Core.cpp
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=42760&r1=42759&r2=42760&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Mon Oct 8 13:14:39 2007
@@ -314,6 +314,11 @@
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 @@
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 ->
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.mli?rev=42760&r1=42759&r2=42760&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.mli (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.mli Mon Oct 8 13:14:39 2007
@@ -295,6 +295,11 @@
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 @@
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 ->
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=42760&r1=42759&r2=42760&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c Mon Oct 8 13:14:39 2007
@@ -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 @@
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 @@
/*--... 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 */
Modified: llvm/trunk/include/llvm-c/Core.h
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/include/llvm-c/Core.h?rev=42760&r1=42759&r2=42760&view=diff
==============================================================================
--- llvm/trunk/include/llvm-c/Core.h (original)
+++ llvm/trunk/include/llvm-c/Core.h Mon Oct 8 13:14:39 2007
@@ -352,6 +352,12 @@
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 ----------------------------------------------===*/
Modified: llvm/trunk/lib/VMCore/Core.cpp
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/lib/VMCore/Core.cpp?rev=42760&r1=42759&r2=42760&view=diff
==============================================================================
--- llvm/trunk/lib/VMCore/Core.cpp (original)
+++ llvm/trunk/lib/VMCore/Core.cpp Mon Oct 8 13:14:39 2007
@@ -562,7 +562,6 @@
}
int LLVMIsGlobalConstant(LLVMValueRef GlobalVar) {
- bool res = unwrap<GlobalVariable>(GlobalVar)->isConstant();
return unwrap<GlobalVariable>(GlobalVar)->isConstant();
}
@@ -684,6 +683,27 @@
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 ----------------------------------------------===*/
Modified: llvm/trunk/test/Bindings/Ocaml/vmcore.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/vmcore.ml?rev=42760&r1=42759&r2=42760&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/vmcore.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/vmcore.ml Mon Oct 8 13:14:39 2007
@@ -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 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 @@
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 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 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 @@
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 @@
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 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 @@
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 @@
* 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 @@
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 @@
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);
More information about the llvm-commits
mailing list