From: Peter Zotov Date: Tue, 28 Oct 2014 19:47:02 +0000 (+0000) Subject: [OCaml] PR19859: Add functions to query and modify branches. X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=commitdiff_plain;h=686e1571765773c8ac18ada098723cbfc379399c [OCaml] PR19859: Add functions to query and modify branches. Patch by Gabriel Radanne . git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@220818 91177308-0d34-0410-b5e6-96231b3b80d8 --- diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 0c434afb34a..9f27b2dc490 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -1026,6 +1026,63 @@ external set_tail_call : bool -> llvalue -> unit = "llvm_set_tail_call" external is_volatile : llvalue -> bool = "llvm_is_volatile" external set_volatile : bool -> llvalue -> unit = "llvm_set_volatile" +(*--... Operations on terminators ..........................................--*) + +let is_terminator llv = + let open ValueKind in + let open Opcode in + match classify_value llv with + | Instruction (Br | IndirectBr | Invoke | Resume | Ret | Switch | Unreachable) + -> true + | _ -> false + +external successor : llvalue -> int -> llbasicblock = "llvm_successor" +external set_successor : llvalue -> int -> llbasicblock -> unit + = "llvm_set_successor" +external num_successors : llvalue -> int = "llvm_num_successors" + +let successors llv = + if not (is_terminator llv) then + raise (Invalid_argument "Llvm.successors can only be used on terminators") + else + Array.init (num_successors llv) (successor llv) + +let iter_successors f llv = + if not (is_terminator llv) then + raise (Invalid_argument "Llvm.iter_successors can only be used on terminators") + else + for i = 0 to num_successors llv - 1 do + f (successor llv i) + done + +let fold_successors f llv z = + if not (is_terminator llv) then + raise (Invalid_argument "Llvm.fold_successors can only be used on terminators") + else + let n = num_successors llv in + let rec aux i acc = + if i >= n then acc + else begin + let llb = successor llv i in + aux (i+1) (f llb acc) + end + in aux 0 z + + +(*--... Operations on branches .............................................--*) +external condition : llvalue -> llvalue = "llvm_condition" +external set_condition : llvalue -> llvalue -> unit + = "llvm_set_condition" +external is_conditional : llvalue -> bool = "llvm_is_conditional" + +let get_branch llv = + if classify_value llv <> ValueKind.Instruction Opcode.Br then + None + else if is_conditional llv then + Some (`Conditional (condition llv, successor llv 0, successor llv 1)) + else + Some (`Unconditional (successor llv 0)) + (*--... Operations on phi nodes ............................................--*) external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit = "llvm_add_incoming" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 10aa706b70e..fb41a8134df 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -1767,6 +1767,52 @@ val is_volatile : llvalue -> bool [llvm::StoreInst::setVolatile]. *) val set_volatile : bool -> llvalue -> unit +(** {7 Operations on terminators} *) + +(** [is_terminator v] returns true if the instruction [v] is a terminator. *) +val is_terminator : llvalue -> bool + +(** [successor v i] returns the successor at index [i] for the value [v]. + See the method [llvm::TerminatorInst::getSuccessor]. *) +val successor : llvalue -> int -> llbasicblock + +(** [set_successor v i o] sets the successor of the value [v] at the index [i] to + the value [o]. + See the method [llvm::TerminatorInst::setSuccessor]. *) +val set_successor : llvalue -> int -> llbasicblock -> unit + +(** [num_successors v] returns the number of successors for the value [v]. + See the method [llvm::TerminatorInst::getNumSuccessors]. *) +val num_successors : llvalue -> int + +(** [successors v] returns the successors of [v]. *) +val successors : llvalue -> llbasicblock array + +(** [iter_successors f v] applies function f to each successor [v] in order. Tail recursive. *) +val iter_successors : (llbasicblock -> unit) -> llvalue -> unit + +(** [fold_successors f v init] is [f (... (f init vN) ...) v1] where [v1,...,vN] are the successors of [v]. Tail recursive. *) +val fold_successors : (llbasicblock -> 'a -> 'a) -> llvalue -> 'a -> 'a + +(** {7 Operations on branches} *) + +(** [is_conditional v] returns true if the branch instruction [v] is conditional. + See the method [llvm::BranchInst::isConditional]. *) +val is_conditional : llvalue -> bool + +(** [condition v] return the condition of the branch instruction [v]. + See the method [llvm::BranchInst::getCondition]. *) +val condition : llvalue -> llvalue + +(** [set_condition v c] sets the condition of the branch instruction [v] to the value [c]. + See the method [llvm::BranchInst::setCondition]. *) +val set_condition : llvalue -> llvalue -> unit + +(** [get_branch c] returns a description of the branch instruction [c]. *) +val get_branch : llvalue -> + [ `Conditional of llvalue * llbasicblock * llbasicblock + | `Unconditional of llbasicblock ] + option (** {7 Operations on phi nodes} *) diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 02107223eb6..7eb88aa62e8 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -1451,6 +1451,43 @@ CAMLprim value llvm_set_volatile(value IsVolatile, return Val_unit; } + +/*--.. Operations on terminators ...........................................--*/ + +/* llvalue -> int -> llbasicblock */ +CAMLprim LLVMBasicBlockRef llvm_successor(LLVMValueRef V, value I) { + return LLVMGetSuccessor(V, Int_val(I)); +} + +/* llvalue -> int -> llvalue -> unit */ +CAMLprim value llvm_set_successor(LLVMValueRef U, value I, LLVMBasicBlockRef B) { + LLVMSetSuccessor(U, Int_val(I), B); + return Val_unit; +} + +/* llvalue -> int */ +CAMLprim value llvm_num_successors(LLVMValueRef V) { + return Val_int(LLVMGetNumSuccessors(V)); +} + +/*--.. Operations on branch ................................................--*/ + +/* llvalue -> llvalue */ +CAMLprim LLVMValueRef llvm_condition(LLVMValueRef V) { + return LLVMGetCondition(V); +} + +/* llvalue -> llvalue -> unit */ +CAMLprim value llvm_set_condition(LLVMValueRef B, LLVMValueRef C) { + LLVMSetCondition(B, C); + return Val_unit; +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_conditional(LLVMValueRef V) { + return Val_bool(LLVMIsConditional(V)); +} + /*--... Operations on phi nodes ............................................--*/ /* (llvalue * llbasicblock) -> llvalue -> unit */ diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index 0d604983678..dcfeaea1e02 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -1197,7 +1197,10 @@ let test_builder () = *) let bb02 = append_block context "Bb02" fn in let b = builder_at_end context bb02 in - ignore (build_br bb02 b) + let br = build_br bb02 b in + insist (successors br = [| bb02 |]) ; + insist (is_conditional br = false) ; + insist (get_branch br = Some (`Unconditional bb02)) ; end; group "cond_br"; begin @@ -1206,7 +1209,12 @@ let test_builder () = let bb03 = append_block context "Bb03" fn in let b = builder_at_end context bb03 in let cond = build_trunc p1 i1_type "build_br" b in - ignore (build_cond_br cond bb03 bb00 b) + let br = build_cond_br cond bb03 bb00 b in + insist (num_successors br = 2) ; + insist (successor br 0 = bb03) ; + insist (successor br 1 = bb00) ; + insist (is_conditional br = true) ; + insist (get_branch br = Some (`Conditional (cond, bb03, bb00))) ; end; group "switch"; begin @@ -1222,6 +1230,8 @@ let test_builder () = ignore (add_case si (const_int i32_type 2) bb2); insist (switch_default_dest si = bb3); end; + insist (num_successors si = 2) ; + insist (get_branch si = None) ; end; group "malloc/free"; begin