diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index dfa772be0a0..ac05a4dc65c 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -270,6 +270,7 @@ external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue = "LLVMConstShuffleVector" (*--... Operations on global variables, functions, and aliases (globals) ...--*) +external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent" external is_declaration : llvalue -> bool = "llvm_is_declaration" external linkage : llvalue -> Linkage.t = "llvm_linkage" external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" @@ -306,8 +307,6 @@ external define_function : string -> lltype -> llmodule -> llvalue external lookup_function : string -> llmodule -> llvalue option = "llvm_lookup_function" external delete_function : llvalue -> unit = "llvm_delete_function" -external params : llvalue -> llvalue array = "llvm_params" -external param : llvalue -> int -> llvalue = "llvm_param" external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" external function_call_conv : llvalue -> int = "llvm_function_call_conv" external set_function_call_conv : int -> llvalue -> unit @@ -317,16 +316,25 @@ external set_collector : string option -> llvalue -> unit = "llvm_set_collector" (* TODO: param attrs *) +(*--... Operations on params ...............................................--*) +external params : llvalue -> llvalue array = "llvm_params" +external param : llvalue -> int -> llvalue = "llvm_param" +external param_parent : llvalue -> llvalue = "LLVMGetParamParent" + (*--... Operations on basic blocks .........................................--*) +external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" +external value_is_block : llvalue -> bool = "llvm_value_is_block" +external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" +external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent" external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks" external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock" external delete_block : llbasicblock -> unit = "llvm_delete_block" external append_block : string -> llvalue -> llbasicblock = "llvm_append_block" external insert_block : string -> llbasicblock -> llbasicblock = "llvm_insert_block" -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 instructions .........................................--*) +external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" (*--... Operations on call sites ...........................................--*) external instruction_call_conv: llvalue -> int @@ -341,13 +349,13 @@ external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" (*===-- Instruction builders ----------------------------------------------===*) -external builder: unit-> llbuilder - = "llvm_builder" +external builder: unit-> llbuilder = "llvm_builder" external builder_before : llvalue -> llbuilder = "llvm_builder_before" external builder_at_end : llbasicblock -> llbuilder = "llvm_builder_at_end" external position_before : llvalue -> llbuilder -> unit = "llvm_position_before" external position_at_end : llbasicblock -> llbuilder -> unit = "llvm_position_at_end" +external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" (*--... Terminators ........................................................--*) external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 2d0b9f07010..5996ecd1b94 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -676,6 +676,10 @@ external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue (** {7 Operations on global variables, functions, and aliases (globals)} *) +(** [global_parent g] is the enclosing module of the global value [g]. + See the method [llvm::GlobalValue::getParent]. *) +external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent" + (** [is_declaration g] returns [true] if the global value [g] is a declaration only. Returns [false] otherwise. See the method [llvm::GlobalValue::isDeclaration]. *) @@ -808,14 +812,6 @@ external lookup_function : string -> llmodule -> llvalue option See the method [llvm::Function::eraseFromParent]. *) external delete_function : llvalue -> unit = "llvm_delete_function" -(** [params f] returns the parameters of function [f]. - See the method [llvm::Function::getArgumentList]. *) -external params : llvalue -> llvalue array = "llvm_params" - -(** [param f n] returns the [n]th parameter of function [f]. - See the method [llvm::Function::getArgumentList]. *) -external param : llvalue -> int -> llvalue = "llvm_param" - (** [is_intrinsic f] returns true if the function [f] is an intrinsic. See the method [llvm::Function::isIntrinsic]. *) external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" @@ -840,6 +836,21 @@ external collector : llvalue -> string option = "llvm_collector" external set_collector : string option -> llvalue -> unit = "llvm_set_collector" +(** {7 Operations on params} *) + +(** [params f] returns the parameters of function [f]. + See the method [llvm::Function::getArgumentList]. *) +external params : llvalue -> llvalue array = "llvm_params" + +(** [param f n] returns the [n]th parameter of function [f]. + See the method [llvm::Function::getArgumentList]. *) +external param : llvalue -> int -> llvalue = "llvm_param" + +(** [param_parent p] returns the parent function that owns the parameter. + See the method [llvm::Argument::getParent]. *) +external param_parent : llvalue -> llvalue = "LLVMGetParamParent" + + (** {7 Operations on basic blocks} *) (** [basic_blocks fn] returns the basic blocks of the function [f]. @@ -865,6 +876,10 @@ external append_block : string -> llvalue -> llbasicblock = "llvm_append_block" external insert_block : string -> llbasicblock -> llbasicblock = "llvm_insert_block" +(** [block_parent bb] returns the parent function that owns the basic block. + See the method [llvm::BasicBlock::getParent]. *) +external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent" + (** [value_of_block bb] losslessly casts [bb] to an [llvalue]. *) external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" @@ -877,6 +892,13 @@ external value_is_block : llvalue -> bool = "llvm_value_is_block" external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" +(** {7 Operations on instructions} *) + +(** [instr_parent i] is the enclosing basic block of the instruction [i]. + See the method [llvm::Instruction::getParent]. *) +external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" + + (** {7 Operations on call sites} *) (** [instruction_call_conv ci] is the calling convention for the call or invoke @@ -886,9 +908,10 @@ external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" external instruction_call_conv: llvalue -> int = "llvm_instruction_call_conv" -(** [set_inst_call_conv cc ci] sets the calling convention for the call or - invoke instruction [ci] to the integer [cc], which can be one of the values - from the module {!CallConv}. See the method [llvm::CallInst::setCallingConv] +(** [set_instruction_call_conv cc ci] sets the calling convention for the call + or invoke instruction [ci] to the integer [cc], which can be one of the + values from the module {!CallConv}. + See the method [llvm::CallInst::setCallingConv] and [llvm::InvokeInst::setCallingConv]. *) external set_instruction_call_conv: int -> llvalue -> unit = "llvm_set_instruction_call_conv" @@ -909,8 +932,8 @@ external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" (** {6 Instruction builders} *) -(** [builder] creates an instruction builder with no position. It is invalid to - use this builder until its position is set with {!position_before} or +(** [builder ()] creates an instruction builder with no position. It is invalid + to use this builder until its position is set with {!position_before} or {!position_at_end}. See the constructor for [llvm::LLVMBuilder]. *) external builder: unit-> llbuilder = "llvm_builder" @@ -932,6 +955,12 @@ external position_before : llvalue -> llbuilder -> unit = "llvm_position_before" external position_at_end : llbasicblock -> llbuilder -> unit = "llvm_position_at_end" +(** [insertion_block b] returns the basic block that the builder [b] is + positioned to insert into. Raises [Not_Found] if the instruction builder is + uninitialized. + See the method [llvm::LLVMBuilder::GetInsertBlock]. *) +external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" + (** {7 Terminators} *) diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 01e83e8819c..c966091ccbb 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -761,6 +761,14 @@ CAMLprim value llvm_position_at_end(LLVMBasicBlockRef BB, value B) { return Val_unit; } +/* llbuilder -> llbasicblock */ +CAMLprim LLVMBasicBlockRef llvm_insertion_block(LLVMBuilderRef B) { + LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B)); + if (!InsertBlock) + raise_not_found(); + return InsertBlock; +} + /*--... Terminators ........................................................--*/ /* llbuilder -> llvalue */ diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h index 2c1228e3012..734f066f1b9 100644 --- a/include/llvm-c/Core.h +++ b/include/llvm-c/Core.h @@ -362,6 +362,7 @@ LLVMValueRef LLVMConstShuffleVector(LLVMValueRef VectorAConstant, LLVMValueRef MaskConstant); /* Operations on global variables, functions, and aliases (globals) */ +LLVMModuleRef LLVMGetGlobalParent(LLVMValueRef Global); int LLVMIsDeclaration(LLVMValueRef Global); LLVMLinkage LLVMGetLinkage(LLVMValueRef Global); void LLVMSetLinkage(LLVMValueRef Global, LLVMLinkage Linkage); @@ -389,19 +390,23 @@ LLVMValueRef LLVMAddFunction(LLVMModuleRef M, const char *Name, LLVMTypeRef FunctionTy); LLVMValueRef LLVMGetNamedFunction(LLVMModuleRef M, const char *Name); void LLVMDeleteFunction(LLVMValueRef Fn); -unsigned LLVMCountParams(LLVMValueRef Fn); -void LLVMGetParams(LLVMValueRef Fn, LLVMValueRef *Params); -LLVMValueRef LLVMGetParam(LLVMValueRef Fn, unsigned Index); unsigned LLVMGetIntrinsicID(LLVMValueRef Fn); unsigned LLVMGetFunctionCallConv(LLVMValueRef Fn); void LLVMSetFunctionCallConv(LLVMValueRef Fn, unsigned CC); const char *LLVMGetCollector(LLVMValueRef Fn); void LLVMSetCollector(LLVMValueRef Fn, const char *Coll); +/* Operations on parameters */ +unsigned LLVMCountParams(LLVMValueRef Fn); +void LLVMGetParams(LLVMValueRef Fn, LLVMValueRef *Params); +LLVMValueRef LLVMGetParam(LLVMValueRef Fn, unsigned Index); +LLVMValueRef LLVMGetParamParent(LLVMValueRef Inst); + /* Operations on basic blocks */ LLVMValueRef LLVMBasicBlockAsValue(LLVMBasicBlockRef Bb); int LLVMValueIsBasicBlock(LLVMValueRef Val); LLVMBasicBlockRef LLVMValueAsBasicBlock(LLVMValueRef Val); +LLVMValueRef LLVMGetBasicBlockParent(LLVMValueRef V); unsigned LLVMCountBasicBlocks(LLVMValueRef Fn); void LLVMGetBasicBlocks(LLVMValueRef Fn, LLVMBasicBlockRef *BasicBlocks); LLVMBasicBlockRef LLVMGetEntryBasicBlock(LLVMValueRef Fn); @@ -410,6 +415,9 @@ LLVMBasicBlockRef LLVMInsertBasicBlock(LLVMBasicBlockRef InsertBeforeBB, const char *Name); void LLVMDeleteBasicBlock(LLVMBasicBlockRef BB); +/* Operations on instructions */ +LLVMBasicBlockRef LLVMGetInstructionParent(LLVMValueRef Inst); + /* Operations on call sites */ void LLVMSetInstructionCallConv(LLVMValueRef Instr, unsigned CC); unsigned LLVMGetInstructionCallConv(LLVMValueRef Instr); @@ -430,6 +438,7 @@ LLVMBasicBlockRef LLVMGetIncomingBlock(LLVMValueRef PhiNode, unsigned Index); LLVMBuilderRef LLVMCreateBuilder(); void LLVMPositionBuilderBefore(LLVMBuilderRef Builder, LLVMValueRef Instr); void LLVMPositionBuilderAtEnd(LLVMBuilderRef Builder, LLVMBasicBlockRef Block); +LLVMBasicBlockRef LLVMGetInsertBlock(LLVMBuilderRef Builder); void LLVMDisposeBuilder(LLVMBuilderRef Builder); /* Terminators */ diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp index 665f0ac1b82..a44f96d8d9c 100644 --- a/lib/VMCore/Core.cpp +++ b/lib/VMCore/Core.cpp @@ -215,7 +215,7 @@ LLVMTypeRef LLVMOpaqueType() { return wrap(llvm::OpaqueType::get()); } -/* Operations on type handles */ +/*--.. Operations on type handles ..........................................--*/ LLVMTypeHandleRef LLVMCreateTypeHandle(LLVMTypeRef PotentiallyAbstractTy) { return wrap(new PATypeHolder(unwrap(PotentiallyAbstractTy))); @@ -546,6 +546,10 @@ LLVMValueRef LLVMConstShuffleVector(LLVMValueRef VectorAConstant, /*--.. Operations on global variables, functions, and aliases (globals) ....--*/ +LLVMModuleRef LLVMGetGlobalParent(LLVMValueRef Global) { + return wrap(unwrap(Global)->getParent()); +} + int LLVMIsDeclaration(LLVMValueRef Global) { return unwrap(Global)->isDeclaration(); } @@ -646,26 +650,6 @@ void LLVMDeleteFunction(LLVMValueRef Fn) { unwrap(Fn)->eraseFromParent(); } -unsigned LLVMCountParams(LLVMValueRef FnRef) { - // This function is strictly redundant to - // LLVMCountParamTypes(LLVMGetElementType(LLVMTypeOf(FnRef))) - return unwrap(FnRef)->getArgumentList().size(); -} - -LLVMValueRef LLVMGetParam(LLVMValueRef FnRef, unsigned index) { - Function::arg_iterator AI = unwrap(FnRef)->arg_begin(); - while (index --> 0) - AI++; - return wrap(AI); -} - -void LLVMGetParams(LLVMValueRef FnRef, LLVMValueRef *ParamRefs) { - Function *Fn = unwrap(FnRef); - for (Function::arg_iterator I = Fn->arg_begin(), - E = Fn->arg_end(); I != E; I++) - *ParamRefs++ = wrap(I); -} - unsigned LLVMGetIntrinsicID(LLVMValueRef Fn) { if (Function *F = dyn_cast(unwrap(Fn))) return F->getIntrinsicID(); @@ -693,10 +677,36 @@ void LLVMSetCollector(LLVMValueRef Fn, const char *Coll) { F->clearCollector(); } +/*--.. Operations on parameters ............................................--*/ + +unsigned LLVMCountParams(LLVMValueRef FnRef) { + // This function is strictly redundant to + // LLVMCountParamTypes(LLVMGetElementType(LLVMTypeOf(FnRef))) + return unwrap(FnRef)->getArgumentList().size(); +} + +void LLVMGetParams(LLVMValueRef FnRef, LLVMValueRef *ParamRefs) { + Function *Fn = unwrap(FnRef); + for (Function::arg_iterator I = Fn->arg_begin(), + E = Fn->arg_end(); I != E; I++) + *ParamRefs++ = wrap(I); +} + +LLVMValueRef LLVMGetParam(LLVMValueRef FnRef, unsigned index) { + Function::arg_iterator AI = unwrap(FnRef)->arg_begin(); + while (index --> 0) + AI++; + return wrap(AI); +} + +LLVMValueRef LLVMGetParamParent(LLVMValueRef V) { + return wrap(unwrap(V)->getParent()); +} + /*--.. Operations on basic blocks ..........................................--*/ -LLVMValueRef LLVMBasicBlockAsValue(LLVMBasicBlockRef Bb) { - return wrap(static_cast(unwrap(Bb))); +LLVMValueRef LLVMBasicBlockAsValue(LLVMBasicBlockRef BB) { + return wrap(static_cast(unwrap(BB))); } int LLVMValueIsBasicBlock(LLVMValueRef Val) { @@ -707,6 +717,10 @@ LLVMBasicBlockRef LLVMValueAsBasicBlock(LLVMValueRef Val) { return wrap(unwrap(Val)); } +LLVMValueRef LLVMGetBasicBlockParent(LLVMValueRef V) { + return wrap(unwrap(V)->getParent()); +} + unsigned LLVMCountBasicBlocks(LLVMValueRef FnRef) { return unwrap(FnRef)->getBasicBlockList().size(); } @@ -736,6 +750,12 @@ void LLVMDeleteBasicBlock(LLVMBasicBlockRef BBRef) { unwrap(BBRef)->eraseFromParent(); } +/*--.. Operations on instructions ..........................................--*/ + +LLVMBasicBlockRef LLVMGetInstructionParent(LLVMValueRef Inst) { + return wrap(unwrap(Inst)->getParent()); +} + /*--.. Call and invoke instructions ........................................--*/ unsigned LLVMGetInstructionCallConv(LLVMValueRef Instr) { @@ -795,6 +815,10 @@ void LLVMPositionBuilderAtEnd(LLVMBuilderRef Builder, LLVMBasicBlockRef Block) { unwrap(Builder)->SetInsertPoint(BB); } +LLVMBasicBlockRef LLVMGetInsertBlock(LLVMBuilderRef Builder) { + return wrap(unwrap(Builder)->GetInsertBlock()); +} + void LLVMDisposeBuilder(LLVMBuilderRef Builder) { delete unwrap(Builder); } diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index 696157e9b10..73b5b286bef 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -478,17 +478,19 @@ let test_functions () = (* RUN: grep {declare i32 @Fn1\(i32, i64\)} < %t.ll *) - group "declare"; - insist (None = lookup_function "Fn1" m); - let fn = declare_function "Fn1" ty m in - insist (pointer_type ty = type_of fn); - insist (is_declaration fn); - insist (0 = Array.length (basic_blocks fn)); - insist (pointer_type ty2 == type_of (declare_function "Fn1" ty2 m)); - insist (fn == declare_function "Fn1" ty m); - insist (None <> lookup_function "Fn1" m); - insist (match lookup_function "Fn1" m with Some x -> x = fn - | None -> false); + begin group "declare"; + insist (None = lookup_function "Fn1" m); + let fn = declare_function "Fn1" ty m in + insist (pointer_type ty = type_of fn); + insist (is_declaration fn); + insist (0 = Array.length (basic_blocks fn)); + insist (pointer_type ty2 == type_of (declare_function "Fn1" ty2 m)); + insist (fn == declare_function "Fn1" ty m); + insist (None <> lookup_function "Fn1" m); + insist (match lookup_function "Fn1" m with Some x -> x = fn + | None -> false); + insist (m == global_parent fn) + end; (* RUN: grep -v {Fn2} < %t.ll *) @@ -593,6 +595,27 @@ let test_basic_blocks () = let test_builder () = let (++) x f = f x; x in + begin group "parent"; + insist (try + ignore (insertion_block (builder ())); + false + with Not_found -> + true); + + let fty = function_type void_type [| i32_type |] in + let fn = define_function "BuilderParent" fty m in + let bb = entry_block fn in + let b = builder_at_end bb in + let p = param fn 0 in + let sum = build_add p p "sum" b in + ignore (build_ret_void b); + + insist (fn = block_parent bb); + insist (fn = param_parent p); + insist (bb = instr_parent sum); + insist (bb = insertion_block b) + end; + group "ret void"; begin (* RUN: grep {ret void} < %t.ll