diff options
| -rw-r--r-- | bindings/ocaml/llvm/llvm.ml | 25 | ||||
| -rw-r--r-- | bindings/ocaml/llvm/llvm.mli | 27 | ||||
| -rw-r--r-- | bindings/ocaml/llvm/llvm_ocaml.c | 68 | ||||
| -rw-r--r-- | include/llvm-c/Core.h | 9 |
4 files changed, 126 insertions, 3 deletions
diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 031bd7cd47..4ae2eb602d 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -201,6 +201,30 @@ module Opcode = struct | Unwind end +module ValueKind = struct + type t = + | NullValue + | Argument + | BasicBlock + | InlineAsm + | MDNode + | MDString + | BlockAddress + | ConstantAggregateZero + | ConstantArray + | ConstantExpr + | ConstantFP + | ConstantInt + | ConstantPointerNull + | ConstantStruct + | ConstantVector + | Function + | GlobalAlias + | GlobalVariable + | UndefValue + | Instruction of Opcode.t +end + exception IoError of string external register_exns : exn -> unit = "llvm_register_core_exns" @@ -290,6 +314,7 @@ external vector_size : lltype -> int = "llvm_vector_size" external void_type : llcontext -> lltype = "llvm_void_type" external label_type : llcontext -> lltype = "llvm_label_type" +external classify_value : llvalue -> ValueKind.t = "llvm_classify_value" (*===-- Values ------------------------------------------------------------===*) external type_of : llvalue -> lltype = "llvm_type_of" external value_name : llvalue -> string = "llvm_value_name" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 2e2db6e531..2cfafdc89a 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -251,6 +251,31 @@ module Opcode : sig | Unwind end +(** The kind of an [llvalue], the result of [classify_value v]. + * See the various [LLVMIsA*] functions. *) +module ValueKind : sig + type t = + | NullValue + | Argument + | BasicBlock + | InlineAsm + | MDNode + | MDString + | BlockAddress + | ConstantAggregateZero + | ConstantArray + | ConstantExpr + | ConstantFP + | ConstantInt + | ConstantPointerNull + | ConstantStruct + | ConstantVector + | Function + | GlobalAlias + | GlobalVariable + | UndefValue + | Instruction of Opcode.t +end (** {6 Iteration} *) @@ -518,6 +543,8 @@ val label_type : llcontext -> lltype See the method [llvm::Value::getType]. *) val type_of : llvalue -> lltype +val classify_value : llvalue -> ValueKind.t + (** [value_name v] returns the name of the value [v]. For global values, this is the symbol name. For instructions and basic blocks, it is the SSA register name. It is meaningless for constants. diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index cbc05448fa..ec2d9490c2 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -375,6 +375,69 @@ CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) { return LLVMTypeOf(Val); } +/* keep in sync with ValueKind.t */ +enum ValueKind { + NullValue=0, + Argument, + BasicBlock, + InlineAsm, + MDNode, + MDString, + BlockAddress, + ConstantAggregateZero, + ConstantArray, + ConstantExpr, + ConstantFP, + ConstantInt, + ConstantPointerNull, + ConstantStruct, + ConstantVector, + Function, + GlobalAlias, + GlobalVariable, + UndefValue, + Instruction +}; + +/* llvalue -> ValueKind.t */ +#define DEFINE_CASE(Val, Kind) \ + do {if (LLVMIsA##Kind(Val)) CAMLreturn(Val_int(Kind));} while(0) + +CAMLprim value llvm_classify_value(LLVMValueRef Val) { + CAMLparam0(); + if (!Val) + CAMLreturn(Val_int(NullValue)); + if (LLVMIsAConstant(Val)) { + DEFINE_CASE(Val, BlockAddress); + DEFINE_CASE(Val, ConstantAggregateZero); + DEFINE_CASE(Val, ConstantArray); + DEFINE_CASE(Val, ConstantExpr); + DEFINE_CASE(Val, ConstantFP); + DEFINE_CASE(Val, ConstantInt); + DEFINE_CASE(Val, ConstantPointerNull); + DEFINE_CASE(Val, ConstantStruct); + DEFINE_CASE(Val, ConstantVector); + } + if (LLVMIsAInstruction(Val)) { + CAMLlocal1(result); + result = caml_alloc_small(1, 0); + Store_field(result, 0, Val_int(LLVMGetInstructionOpcode(Val))); + CAMLreturn(result); + } + if (LLVMIsAGlobalValue(Val)) { + DEFINE_CASE(Val, Function); + DEFINE_CASE(Val, GlobalAlias); + DEFINE_CASE(Val, GlobalVariable); + } + DEFINE_CASE(Val, Argument); + DEFINE_CASE(Val, BasicBlock); + DEFINE_CASE(Val, InlineAsm); + DEFINE_CASE(Val, MDNode); + DEFINE_CASE(Val, MDString); + DEFINE_CASE(Val, UndefValue); + failwith("Unknown Value class"); +} + /* llvalue -> string */ CAMLprim value llvm_value_name(LLVMValueRef Val) { return copy_string(LLVMGetValueName(Val)); @@ -1034,7 +1097,10 @@ DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef, /* llvalue -> Opcode.t */ CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) { - LLVMOpcode o = LLVMGetInstructionOpcode(Inst); + LLVMOpcode o; + if (!LLVMIsAInstruction(Inst)) + failwith("Not an instruction"); + o = LLVMGetInstructionOpcode(Inst); assert (o <= LLVMUnwind ); return Val_int(o); } diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h index 6a53259245..d23b91c4e0 100644 --- a/include/llvm-c/Core.h +++ b/include/llvm-c/Core.h @@ -449,8 +449,11 @@ LLVMTypeRef LLVMX86MMXType(void); macro(Argument) \ macro(BasicBlock) \ macro(InlineAsm) \ + macro(MDNode) \ + macro(MDString) \ macro(User) \ macro(Constant) \ + macro(BlockAddress) \ macro(ConstantAggregateZero) \ macro(ConstantArray) \ macro(ConstantExpr) \ @@ -470,14 +473,15 @@ LLVMTypeRef LLVMX86MMXType(void); macro(IntrinsicInst) \ macro(DbgInfoIntrinsic) \ macro(DbgDeclareInst) \ + macro(EHExceptionInst) \ macro(EHSelectorInst) \ macro(MemIntrinsic) \ macro(MemCpyInst) \ macro(MemMoveInst) \ macro(MemSetInst) \ macro(CmpInst) \ - macro(FCmpInst) \ - macro(ICmpInst) \ + macro(FCmpInst) \ + macro(ICmpInst) \ macro(ExtractElementInst) \ macro(GetElementPtrInst) \ macro(InsertElementInst) \ @@ -489,6 +493,7 @@ LLVMTypeRef LLVMX86MMXType(void); macro(StoreInst) \ macro(TerminatorInst) \ macro(BranchInst) \ + macro(IndirectBrInst) \ macro(InvokeInst) \ macro(ReturnInst) \ macro(SwitchInst) \ |