OCaml bindings: add some missing functions and testcases.

The C bindings exposed some APIs that weren't covered by the OCaml bindings

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@141997 91177308-0d34-0410-b5e6-96231b3b80d8
This commit is contained in:
Torok Edwin 2011-10-14 20:38:33 +00:00
parent 0be167bab2
commit ff616cb440
8 changed files with 301 additions and 4 deletions

View File

@ -261,6 +261,7 @@ external set_data_layout: string -> llmodule -> unit
external dump_module : llmodule -> unit = "llvm_dump_module"
external set_module_inline_asm : llmodule -> string -> unit
= "llvm_set_module_inline_asm"
external module_context : llmodule -> llcontext = "LLVMGetModuleContext"
(*===-- Types -------------------------------------------------------------===*)
external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
@ -321,6 +322,7 @@ external vector_size : lltype -> int = "llvm_vector_size"
(*--... Operations on other types ..........................................--*)
external void_type : llcontext -> lltype = "llvm_void_type"
external label_type : llcontext -> lltype = "llvm_label_type"
external type_by_name : llmodule -> string -> lltype option = "llvm_type_by_name"
external classify_value : llvalue -> ValueKind.t = "llvm_classify_value"
(*===-- Values ------------------------------------------------------------===*)
@ -812,6 +814,8 @@ external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos
= "llvm_block_end"
external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos
= "llvm_block_pred"
external block_terminator : llbasicblock -> llvalue option =
"llvm_block_terminator"
let rec iter_block_range f i e =
if i = e then () else
@ -936,6 +940,7 @@ external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
= "llvm_add_incoming"
external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
external delete_instruction : llvalue -> unit = "llvm_delete_instruction"
(*===-- Instruction builders ----------------------------------------------===*)
external builder : llcontext -> llbuilder = "llvm_builder"
@ -978,8 +983,15 @@ external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder ->
llvalue = "llvm_build_cond_br"
external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
= "llvm_build_switch"
external build_malloc : lltype -> string -> llbuilder -> llvalue =
"llvm_build_malloc"
external build_array_malloc : lltype -> llvalue -> string -> llbuilder ->
llvalue = "llvm_build_array_malloc"
external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free"
external add_case : llvalue -> llvalue -> llbasicblock -> unit
= "llvm_add_case"
external switch_default_dest : llvalue -> llbasicblock =
"LLVMGetSwitchDefaultDest"
external build_indirect_br : llvalue -> int -> llbuilder -> llvalue
= "llvm_build_indirect_br"
external add_destination : llvalue -> llbasicblock -> unit
@ -990,6 +1002,8 @@ external build_invoke : llvalue -> llvalue array -> llbasicblock ->
external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
llvalue = "llvm_build_landingpad"
external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup"
external add_clause : llvalue -> llvalue -> unit = "llvm_add_clause"
external build_resume : llvalue -> llbuilder -> llvalue = "llvm_build_resume"
external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable"
(*--... Arithmetic .........................................................--*)

View File

@ -363,7 +363,9 @@ val dump_module : llmodule -> unit
the method [llvm::Module::setModuleInlineAsm]. *)
val set_module_inline_asm : llmodule -> string -> unit
(** [module_context m] returns the context of the specified module.
* See the method [llvm::Module::getContext] *)
val module_context : llmodule -> llcontext
(** {6 Types} *)
@ -552,6 +554,11 @@ val void_type : llcontext -> lltype
[llvm::Type::LabelTy]. *)
val label_type : llcontext -> lltype
(** [type_by_name m name] returns the specified type from the current module
* if it exists.
* See the method [llvm::Module::getTypeByName] *)
val type_by_name : llmodule -> string -> lltype option
(* {6 Values} *)
(** [type_of v] returns the type of the value [v].
@ -1508,6 +1515,7 @@ val block_end : llvalue -> (llvalue, llbasicblock) llrev_pos
See the method [llvm::Function::iterator::operator--]. *)
val block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos
val block_terminator : llbasicblock -> llvalue option
(** [rev_iter_blocks f fn] applies function [f] to each of the basic blocks
of function [fn] in reverse order. Tail recursive. *)
@ -1625,7 +1633,9 @@ val add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
See the method [llvm::PHINode::getIncomingValue]. *)
val incoming : llvalue -> (llvalue * llbasicblock) list
(** [delete_instruction i] deletes the instruction [i].
* See the method [llvm::Instruction::eraseFromParent]. *)
val delete_instruction : llvalue -> unit
(** {6 Instruction builders} *)
@ -1739,12 +1749,30 @@ val build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder ->
See the method [llvm::LLVMBuilder::CreateSwitch]. *)
val build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
(** [build_malloc ty name b] creates an [malloc]
instruction at the position specified by the instruction builder [b].
See the method [llvm::CallInst::CreateMalloc]. *)
val build_malloc : lltype -> string -> llbuilder -> llvalue
(** [build_array_malloc ty val name b] creates an [array malloc]
instruction at the position specified by the instruction builder [b].
See the method [llvm::CallInst::CreateArrayMalloc]. *)
val build_array_malloc : lltype -> llvalue -> string -> llbuilder -> llvalue
(** [build_free p b] creates a [free]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateFree]. *)
val build_free : llvalue -> llbuilder -> llvalue
(** [add_case sw onval bb] causes switch instruction [sw] to branch to [bb]
when its input matches the constant [onval].
See the method [llvm::SwitchInst::addCase]. **)
val add_case : llvalue -> llvalue -> llbasicblock -> unit
(** [switch_default_dest sw] returns the default destination of the [switch]
* instruction.
* See the method [llvm:;SwitchInst::getDefaultDest]. **)
val switch_default_dest : llvalue -> llbasicblock
(** [build_indirect_br addr count b] creates a
[indirectbr %addr]
@ -1778,6 +1806,15 @@ val build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
See the method [llvm::LandingPadInst::setCleanup]. *)
val set_cleanup : llvalue -> bool -> unit
(** [add_clause lp clause] adds the clause to the [landingpad]instruction.
See the method [llvm::LandingPadInst::addClause]. *)
val add_clause : llvalue -> llvalue -> unit
(* [build_resume exn b] builds a [resume exn] instruction
* at the position specified by the instruction builder [b].
* See the method [llvm::LLVMBuilder::CreateResume] *)
val build_resume : llvalue -> llbuilder -> llvalue
(** [build_unreachable b] creates an
[unreachable]
instruction at the position specified by the instruction builder [b].

View File

@ -387,6 +387,18 @@ CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
return LLVMLabelTypeInContext(Context);
}
CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
{
CAMLparam1(Name);
LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
if (Ty) {
value Option = alloc(1, 0);
Field(Option, 0) = (value) Ty;
CAMLreturn(Option);
}
CAMLreturn(Val_int(0));
}
/*===-- VALUES ------------------------------------------------------------===*/
/* llvalue -> lltype */
@ -1098,6 +1110,19 @@ CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
DEFINE_ITERATORS(
block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
/* llbasicblock -> llvalue option */
CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
{
CAMLparam0();
LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
if (Term) {
value Option = alloc(1, 0);
Field(Option, 0) = (value) Term;
CAMLreturn(Option);
}
CAMLreturn(Val_int(0));
}
/* llvalue -> llbasicblock array */
CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
@ -1232,6 +1257,11 @@ CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
CAMLreturn(Tl);
}
/* llvalue -> unit */
CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
LLVMInstructionEraseFromParent(Instruction);
return Val_unit;
}
/*===-- Instruction builders ----------------------------------------------===*/
@ -1359,6 +1389,27 @@ CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
}
/* lltype -> string -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
value B)
{
return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
}
/* lltype -> llvalue -> string -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
LLVMValueRef Val,
value Name, value B)
{
return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
}
/* llvalue -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
{
return LLVMBuildFree(Builder_val(B), P);
}
/* llvalue -> llvalue -> llbasicblock -> unit */
CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
LLVMBasicBlockRef Dest) {
@ -1399,6 +1450,7 @@ CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
Args[4], Args[5]);
}
/* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
value NumClauses, value Name,
value B) {
@ -1406,12 +1458,27 @@ CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
String_val(Name));
}
/* llvalue -> llvalue -> unit */
CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
{
LLVMAddClause(LandingPadInst, ClauseVal);
return Val_unit;
}
/* llvalue -> bool -> unit */
CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
{
LLVMSetCleanup(LandingPadInst, Bool_val(flag));
return Val_unit;
}
/* llvalue -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
{
return LLVMBuildResume(Builder_val(B), Exn);
}
/* llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
return LLVMBuildUnreachable(Builder_val(B));

View File

@ -20,6 +20,15 @@ external add_aggressive_dce : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
external
add_scalar_repl_aggregation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_scalar_repl_aggregation"
external
add_scalar_repl_aggregation_ssa : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_scalar_repl_aggregation_ssa"
external
add_scalar_repl_aggregation_with_threshold : int -> [<Llvm.PassManager.any] Llvm.PassManager.t
-> unit
= "llvm_add_scalar_repl_aggregation_with_threshold"
external add_ind_var_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t
-> unit
= "llvm_add_ind_var_simplification"
@ -67,6 +76,36 @@ external add_memcpy_opt : [<Llvm.PassManager.any] Llvm.PassManager.t
external add_loop_deletion : [<Llvm.PassManager.any] Llvm.PassManager.t
-> unit
= "llvm_add_loop_deletion"
external add_loop_idiom : [<Llvm.PassManager.any] Llvm.PassManager.t
-> unit
= "llvm_add_loop_idiom"
external
add_lib_call_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_lib_call_simplification"
external
add_verifier : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_verifier"
external
add_correlated_value_propagation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_correlated_value_propagation"
external
add_early_cse : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_early_cse"
external
add_lower_expect_intrinsic : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_lower_expect_intrinsic"
external
add_type_based_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_type_based_alias_analysis"
external
add_basic_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_basic_alias_analysis"

View File

@ -35,6 +35,17 @@ external
add_scalar_repl_aggregation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_scalar_repl_aggregation"
(** See the [llvm::createScalarReplAggregatesPassSSA] function. *)
external
add_scalar_repl_aggregation_ssa : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_scalar_repl_aggregation_ssa"
(** See the [llvm::createScalarReplAggregatesWithThreshold] function. *)
external
add_scalar_repl_aggregation_with_threshold : int -> [<Llvm.PassManager.any] Llvm.PassManager.t
-> unit
= "llvm_add_scalar_repl_aggregation_with_threshold"
(** See the [llvm::createIndVarSimplifyPass] function. *)
external add_ind_var_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t
-> unit
@ -112,7 +123,42 @@ external add_loop_deletion : [<Llvm.PassManager.any] Llvm.PassManager.t
-> unit
= "llvm_add_loop_deletion"
external add_loop_idiom : [<Llvm.PassManager.any] Llvm.PassManager.t
-> unit
= "llvm_add_loop_idiom"
(** See the [llvm::createSimplifyLibCallsPass] function. *)
external
add_lib_call_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_lib_call_simplification"
(** See the [llvm::createVerifierPass] function. *)
external
add_verifier : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_verifier"
(** See the [llvm::createCorrelatedValuePropagationPass] function. *)
external
add_correlated_value_propagation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_correlated_value_propagation"
(** See the [llvm::createEarlyCSE] function. *)
external
add_early_cse : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_early_cse"
(** See the [llvm::createLowerExpectIntrinsicPass] function. *)
external
add_lower_expect_intrinsic : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_lower_expect_intrinsic"
(** See the [llvm::createTypeBasedAliasAnalysisPass] function. *)
external
add_type_based_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_type_based_alias_analysis"
(** See the [llvm::createBasicAliasAnalysisPass] function. *)
external
add_basic_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
= "llvm_add_basic_alias_analysis"

View File

@ -49,6 +49,19 @@ CAMLprim value llvm_add_scalar_repl_aggregation(LLVMPassManagerRef PM) {
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_scalar_repl_aggregation_ssa(LLVMPassManagerRef PM) {
LLVMAddScalarReplAggregatesPassSSA(PM);
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> int -> unit */
CAMLprim value llvm_add_scalar_repl_aggregation_with_threshold(value threshold,
LLVMPassManagerRef PM) {
LLVMAddScalarReplAggregatesPassWithThreshold(PM, Int_val(threshold));
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_ind_var_simplification(LLVMPassManagerRef PM) {
LLVMAddIndVarSimplifyPass(PM);
@ -69,7 +82,7 @@ CAMLprim value llvm_add_licm(LLVMPassManagerRef PM) {
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_loop_unswitch(LLVMPassManagerRef PM) {
LLVMAddLoopUnrollPass(PM);
LLVMAddLoopUnswitchPass(PM);
return Val_unit;
}
@ -139,8 +152,50 @@ CAMLprim value llvm_add_loop_deletion(LLVMPassManagerRef PM) {
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_loop_idiom(LLVMPassManagerRef PM) {
LLVMAddLoopIdiomPass(PM);
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_lib_call_simplification(LLVMPassManagerRef PM) {
LLVMAddSimplifyLibCallsPass(PM);
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_verifier(LLVMPassManagerRef PM) {
LLVMAddVerifierPass(PM);
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_correlated_value_propagation(LLVMPassManagerRef PM) {
LLVMAddCorrelatedValuePropagationPass(PM);
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_early_cse(LLVMPassManagerRef PM) {
LLVMAddEarlyCSEPass(PM);
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_lower_expect_intrinsic(LLVMPassManagerRef PM) {
LLVMAddLowerExpectIntrinsicPass(PM);
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_type_based_alias_analysis(LLVMPassManagerRef PM) {
LLVMAddTypeBasedAliasAnalysisPass(PM);
return Val_unit;
}
/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
CAMLprim value llvm_add_basic_alias_analysis(LLVMPassManagerRef PM) {
LLVMAddBasicAliasAnalysisPass(PM);
return Val_unit;
}

View File

@ -42,11 +42,14 @@ let test_transforms () =
ignore (PassManager.create_function m
++ TargetData.add td
++ add_verifier
++ add_constant_propagation
++ add_sccp
++ add_dead_store_elimination
++ add_aggressive_dce
++ add_scalar_repl_aggregation
++ add_scalar_repl_aggregation_ssa
++ add_scalar_repl_aggregation_with_threshold 4
++ add_ind_var_simplification
++ add_instruction_combination
++ add_licm
@ -62,7 +65,14 @@ let test_transforms () =
++ add_gvn
++ add_memcpy_opt
++ add_loop_deletion
++ add_loop_idiom
++ add_lib_call_simplification
++ add_correlated_value_propagation
++ add_early_cse
++ add_lower_expect_intrinsic
++ add_type_based_alias_analysis
++ add_basic_alias_analysis
++ add_verifier
++ PassManager.initialize
++ PassManager.run_function fn
++ PassManager.finalize

View File

@ -857,6 +857,14 @@ let test_builder () =
let bb00 = append_block context "Bb00" fn in
ignore (build_unreachable (builder_at_end context bb00));
group "function attribute";
begin
ignore (add_function_attr fn Attribute.UWTable);
(* RUN: grep "X7.*uwtable" < %t.ll
*)
insist ([Attribute.UWTable] = function_attr fn);
end;
(* see test/Feature/exception.ll *)
let bblpad = append_block context "Bblpad" fn in
let rt = struct_type context [| pointer_type i8_type; i32_type |] in
@ -872,10 +880,17 @@ let test_builder () =
let lp = build_landingpad rt personality 0 "lpad"
(builder_at_end context bblpad) in begin
set_cleanup lp true;
ignore (build_unreachable (builder_at_end context bblpad));
add_clause lp ztic;
insist((pointer_type (pointer_type i8_type)) = type_of ztid);
let ety = pointer_type (pointer_type i8_type) in
add_clause lp (const_array ety [| ztipkc; ztid |]);
ignore (build_resume lp (builder_at_end context bblpad));
end;
(* RUN: grep "landingpad.*personality.*__gxx_personality_v0" < %t.ll
* RUN: grep "cleanup" < %t.ll
* RUN: grep "catch.*i8\*\*.*@_ZTIc" < %t.ll
* RUN: grep "filter.*@_ZTIPKc.*@_ZTId" < %t.ll
* RUN: grep "resume " < %t.ll
* *)
end;
@ -914,9 +929,23 @@ let test_builder () =
ignore (build_unreachable (builder_at_end context bb3));
let si = build_switch p1 bb3 1 (builder_at_end context bb1) in begin
ignore (add_case si (const_int i32_type 2) bb2);
insist (switch_default_dest si = bb3);
end;
end;
group "malloc/free"; begin
(* RUN: grep {call.*@malloc(i32 ptrtoint} < %t.ll
* RUN: grep {call.*@free(i8\*} < %t.ll
* RUN: grep {call.*@malloc(i32 %} < %t.ll
*)
let bb1 = append_block context "MallocBlock1" fn in
let m1 = (build_malloc (pointer_type i32_type) "m1"
(builder_at_end context bb1)) in
ignore (build_free m1 (builder_at_end context bb1));
ignore (build_array_malloc i32_type p1 "m2" (builder_at_end context bb1));
ignore (build_unreachable (builder_at_end context bb1));
end;
group "indirectbr"; begin
(* RUN: grep {indirectbr i8\\* blockaddress(@X7, %IBRBlock2), \\\[label %IBRBlock2, label %IBRBlock3\\\]} < %t.ll
*)