From: Torok Edwin Date: Fri, 14 Oct 2011 20:37:49 +0000 (+0000) Subject: ocaml bindings: add getopcode for constant and instruction, and int64_of_const. X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=commitdiff_plain;h=6563c879964c3bcf5c77d40da8d4c807adf605aa ocaml bindings: add getopcode for constant and instruction, and int64_of_const. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@141990 91177308-0d34-0410-b5e6-96231b3b80d8 --- diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index eaca48d8496..031bd7cd471 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -130,6 +130,77 @@ module Fcmp = struct | True end +module Opcode = struct + type t = + | Invalid (* not an instruction *) + (* Terminator Instructions *) + | Ret + | Br + | Switch + | IndirectBr + | Invoke + | Invalid2 + | Unreachable + (* Standard Binary Operators *) + | Add + | FAdd + | Sub + | FSub + | Mul + | FMul + | UDiv + | SDiv + | FDiv + | URem + | SRem + | FRem + (* Logical Operators *) + | Shl + | LShr + | AShr + | And + | Or + | Xor + (* Memory Operators *) + | Alloca + | Load + | Store + | GetElementPtr + (* Cast Operators *) + | Trunc + | ZExt + | SExt + | FPToUI + | FPToSI + | UIToFP + | SIToFP + | FPTrunc + | FPExt + | PtrToInt + | IntToPtr + | BitCast + (* Other Operators *) + | ICmp + | FCmp + | PHI + | Call + | Select + | UserOp1 + | UserOp2 + | VAArg + | ExtractElement + | InsertElement + | ShuffleVector + | ExtractValue + | InsertValue + | Fence + | AtomicCmpXchg + | AtomicRMW + | Resume + | LandingPad + | Unwind +end + exception IoError of string external register_exns : exn -> unit = "llvm_register_core_exns" @@ -272,6 +343,7 @@ external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull" external undef : lltype -> llvalue = "LLVMGetUndef" external is_null : llvalue -> bool = "llvm_is_null" external is_undef : llvalue -> bool = "llvm_is_undef" +external constexpr_opcode : llvalue -> Opcode.t = "llvm_constexpr_get_opcode" (*--... Operations on instructions .........................................--*) external has_metadata : llvalue -> bool = "llvm_has_metadata" @@ -289,6 +361,8 @@ external get_named_metadata : llmodule -> string -> llvalue array = "llvm_get_na external const_int : lltype -> int -> llvalue = "llvm_const_int" external const_of_int64 : lltype -> Int64.t -> bool -> llvalue = "llvm_const_of_int64" +external int64_of_const : llvalue -> Int64.t option + = "llvm_int64_of_const" external const_int_of_string : lltype -> string -> int -> llvalue = "llvm_const_int_of_string" external const_float : lltype -> float -> llvalue = "llvm_const_float" @@ -706,6 +780,7 @@ external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos = "llvm_instr_pred" +external instr_opcode : llvalue -> Opcode.t = "llvm_instr_get_opcode" external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate" let rec iter_instrs_range f i e = diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 0f1e9a90170..2e2db6e5310 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -179,6 +179,78 @@ module Fcmp : sig | True end +(** The opcodes for LLVM instructions and constant expressions. *) +module Opcode : sig + type t = + | Invalid (* not an instruction *) + (* Terminator Instructions *) + | Ret + | Br + | Switch + | IndirectBr + | Invoke + | Invalid2 + | Unreachable + (* Standard Binary Operators *) + | Add + | FAdd + | Sub + | FSub + | Mul + | FMul + | UDiv + | SDiv + | FDiv + | URem + | SRem + | FRem + (* Logical Operators *) + | Shl + | LShr + | AShr + | And + | Or + | Xor + (* Memory Operators *) + | Alloca + | Load + | Store + | GetElementPtr + (* Cast Operators *) + | Trunc + | ZExt + | SExt + | FPToUI + | FPToSI + | UIToFP + | SIToFP + | FPTrunc + | FPExt + | PtrToInt + | IntToPtr + | BitCast + (* Other Operators *) + | ICmp + | FCmp + | PHI + | Call + | Select + | UserOp1 + | UserOp2 + | VAArg + | ExtractElement + | InsertElement + | ShuffleVector + | ExtractValue + | InsertValue + | Fence + | AtomicCmpXchg + | AtomicRMW + | Resume + | LandingPad + | Unwind +end + (** {6 Iteration} *) @@ -543,7 +615,7 @@ val is_null : llvalue -> bool otherwise. Similar to [llvm::isa]. *) val is_undef : llvalue -> bool - +val constexpr_opcode : llvalue -> Opcode.t (** {7 Operations on instructions} *) (** [has_metadata i] returns whether or not the instruction [i] has any @@ -595,6 +667,10 @@ val const_int : lltype -> int -> llvalue [i]. See the method [llvm::ConstantInt::get]. *) val const_of_int64 : lltype -> Int64.t -> bool -> llvalue +(** [int64_of_const c] returns the int64 value of the [c] constant integer. + * None is returned if this is not an integer constant, or bitwidth exceeds 64. + * See the method [llvm::ConstantInt::getSExtValue].*) +val int64_of_const : llvalue -> Int64.t option (** [const_int_of_string ty s r] returns the integer constant of type [ty] and * value [s], with the radix [r]. See the method [llvm::ConstantInt::get]. *) @@ -1439,6 +1515,7 @@ val instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos [f1,...,fN] are the instructions of basic block [bb]. Tail recursive. *) val fold_right_instrs: (llvalue -> 'a -> 'a) -> llbasicblock -> 'a -> 'a +val instr_opcode : llvalue -> Opcode.t val icmp_predicate : llvalue -> Icmp.t option diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 21519d474df..cbc05448fa7 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -427,6 +427,12 @@ CAMLprim value llvm_is_undef(LLVMValueRef Val) { return Val_bool(LLVMIsUndef(Val)); } +/* llvalue -> Opcode.t */ +CAMLprim value llvm_constexpr_get_opcode(LLVMValueRef Val) { + return LLVMIsAConstantExpr(Val) ? + Val_int(LLVMGetConstOpcode(Val)) : Val_int(0); +} + /*--... Operations on instructions .........................................--*/ /* llvalue -> bool */ @@ -512,6 +518,19 @@ CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N, return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt)); } +/* llvalue -> Int64.t */ +CAMLprim value llvm_int64_of_const(LLVMValueRef Const) +{ + CAMLparam0(); + if (LLVMIsAConstantInt(Const) && + LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64) { + value Option = alloc(1, 0); + Field(Option, 0) = caml_copy_int64(LLVMConstIntGetSExtValue(Const)); + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + /* lltype -> string -> int -> llvalue */ CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S, value Radix) { @@ -1013,6 +1032,12 @@ CAMLprim value llvm_value_is_block(LLVMValueRef Val) { DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef, LLVMGetInstructionParent) +/* llvalue -> Opcode.t */ +CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) { + LLVMOpcode o = LLVMGetInstructionOpcode(Inst); + assert (o <= LLVMUnwind ); + return Val_int(o); +} /* llvalue -> ICmp.t */ CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) { diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h index 10e9a80bcb5..6a532592455 100644 --- a/include/llvm-c/Core.h +++ b/include/llvm-c/Core.h @@ -789,6 +789,7 @@ LLVMBasicBlockRef LLVMGetInstructionParent(LLVMValueRef Inst); LLVMValueRef LLVMGetNextInstruction(LLVMValueRef Inst); LLVMValueRef LLVMGetPreviousInstruction(LLVMValueRef Inst); void LLVMInstructionEraseFromParent(LLVMValueRef Inst); +LLVMOpcode LLVMGetInstructionOpcode(LLVMValueRef Inst); LLVMIntPredicate LLVMGetICmpPredicate(LLVMValueRef Inst); /* Operations on call sites */ diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp index 77d2e74cd22..a505e4b4f5e 100644 --- a/lib/VMCore/Core.cpp +++ b/lib/VMCore/Core.cpp @@ -1591,6 +1591,12 @@ LLVMIntPredicate LLVMGetICmpPredicate(LLVMValueRef Inst) { return (LLVMIntPredicate)0; } +LLVMOpcode LLVMGetInstructionOpcode(LLVMValueRef Inst) { + if (Instruction *C = dyn_cast(unwrap(Inst))) + return map_to_llvmopcode(C->getOpcode()); + return (LLVMOpcode)0; +} + /*--.. Call and invoke instructions ........................................--*/ unsigned LLVMGetInstructionCallConv(LLVMValueRef Instr) {