llvm.org GIT mirror llvm / ff616cb
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 Torok Edwin 7 years ago
8 changed file(s) with 301 addition(s) and 4 deletion(s). Raw diff Collapse all Expand all
260260 external dump_module : llmodule -> unit = "llvm_dump_module"
261261 external set_module_inline_asm : llmodule -> string -> unit
262262 = "llvm_set_module_inline_asm"
263 external module_context : llmodule -> llcontext = "LLVMGetModuleContext"
263264
264265 (*===-- Types -------------------------------------------------------------===*)
265266 external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
320321 (*--... Operations on other types ..........................................--*)
321322 external void_type : llcontext -> lltype = "llvm_void_type"
322323 external label_type : llcontext -> lltype = "llvm_label_type"
324 external type_by_name : llmodule -> string -> lltype option = "llvm_type_by_name"
323325
324326 external classify_value : llvalue -> ValueKind.t = "llvm_classify_value"
325327 (*===-- Values ------------------------------------------------------------===*)
811813 = "llvm_block_end"
812814 external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos
813815 = "llvm_block_pred"
816 external block_terminator : llbasicblock -> llvalue option =
817 "llvm_block_terminator"
814818
815819 let rec iter_block_range f i e =
816820 if i = e then () else
935939 = "llvm_add_incoming"
936940 external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
937941
942 external delete_instruction : llvalue -> unit = "llvm_delete_instruction"
938943
939944 (*===-- Instruction builders ----------------------------------------------===*)
940945 external builder : llcontext -> llbuilder = "llvm_builder"
977982 llvalue = "llvm_build_cond_br"
978983 external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
979984 = "llvm_build_switch"
985 external build_malloc : lltype -> string -> llbuilder -> llvalue =
986 "llvm_build_malloc"
987 external build_array_malloc : lltype -> llvalue -> string -> llbuilder ->
988 llvalue = "llvm_build_array_malloc"
989 external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free"
980990 external add_case : llvalue -> llvalue -> llbasicblock -> unit
981991 = "llvm_add_case"
992 external switch_default_dest : llvalue -> llbasicblock =
993 "LLVMGetSwitchDefaultDest"
982994 external build_indirect_br : llvalue -> int -> llbuilder -> llvalue
983995 = "llvm_build_indirect_br"
984996 external add_destination : llvalue -> llbasicblock -> unit
9891001 external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
9901002 llvalue = "llvm_build_landingpad"
9911003 external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup"
1004 external add_clause : llvalue -> llvalue -> unit = "llvm_add_clause"
1005 external build_resume : llvalue -> llbuilder -> llvalue = "llvm_build_resume"
9921006 external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable"
9931007
9941008 (*--... Arithmetic .........................................................--*)
362362 the method [llvm::Module::setModuleInlineAsm]. *)
363363 val set_module_inline_asm : llmodule -> string -> unit
364364
365
365 (** [module_context m] returns the context of the specified module.
366 * See the method [llvm::Module::getContext] *)
367 val module_context : llmodule -> llcontext
366368
367369 (** {6 Types} *)
368370
550552 (** [label_type c] creates a type of a basic block in the context [c]. See
551553 [llvm::Type::LabelTy]. *)
552554 val label_type : llcontext -> lltype
555
556 (** [type_by_name m name] returns the specified type from the current module
557 * if it exists.
558 * See the method [llvm::Module::getTypeByName] *)
559 val type_by_name : llmodule -> string -> lltype option
553560
554561 (* {6 Values} *)
555562
15071514 See the method [llvm::Function::iterator::operator--]. *)
15081515 val block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos
15091516
1517 val block_terminator : llbasicblock -> llvalue option
15101518
15111519 (** [rev_iter_blocks f fn] applies function [f] to each of the basic blocks
15121520 of function [fn] in reverse order. Tail recursive. *)
16241632 See the method [llvm::PHINode::getIncomingValue]. *)
16251633 val incoming : llvalue -> (llvalue * llbasicblock) list
16261634
1627
1635 (** [delete_instruction i] deletes the instruction [i].
1636 * See the method [llvm::Instruction::eraseFromParent]. *)
1637 val delete_instruction : llvalue -> unit
16281638
16291639 (** {6 Instruction builders} *)
16301640
17381748 See the method [llvm::LLVMBuilder::CreateSwitch]. *)
17391749 val build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
17401750
1751 (** [build_malloc ty name b] creates an [malloc]
1752 instruction at the position specified by the instruction builder [b].
1753 See the method [llvm::CallInst::CreateMalloc]. *)
1754 val build_malloc : lltype -> string -> llbuilder -> llvalue
1755
1756 (** [build_array_malloc ty val name b] creates an [array malloc]
1757 instruction at the position specified by the instruction builder [b].
1758 See the method [llvm::CallInst::CreateArrayMalloc]. *)
1759 val build_array_malloc : lltype -> llvalue -> string -> llbuilder -> llvalue
1760
1761 (** [build_free p b] creates a [free]
1762 instruction at the position specified by the instruction builder [b].
1763 See the method [llvm::LLVMBuilder::CreateFree]. *)
1764 val build_free : llvalue -> llbuilder -> llvalue
17411765
17421766 (** [add_case sw onval bb] causes switch instruction [sw] to branch to [bb]
17431767 when its input matches the constant [onval].
17441768 See the method [llvm::SwitchInst::addCase]. **)
17451769 val add_case : llvalue -> llvalue -> llbasicblock -> unit
17461770
1771 (** [switch_default_dest sw] returns the default destination of the [switch]
1772 * instruction.
1773 * See the method [llvm:;SwitchInst::getDefaultDest]. **)
1774 val switch_default_dest : llvalue -> llbasicblock
17471775
17481776 (** [build_indirect_br addr count b] creates a
17491777 [indirectbr %addr]
17761804 (** [set_cleanup lp] sets the cleanup flag in the [landingpad]instruction.
17771805 See the method [llvm::LandingPadInst::setCleanup]. *)
17781806 val set_cleanup : llvalue -> bool -> unit
1807
1808 (** [add_clause lp clause] adds the clause to the [landingpad]instruction.
1809 See the method [llvm::LandingPadInst::addClause]. *)
1810 val add_clause : llvalue -> llvalue -> unit
1811
1812 (* [build_resume exn b] builds a [resume exn] instruction
1813 * at the position specified by the instruction builder [b].
1814 * See the method [llvm::LLVMBuilder::CreateResume] *)
1815 val build_resume : llvalue -> llbuilder -> llvalue
17791816
17801817 (** [build_unreachable b] creates an
17811818 [unreachable]
386386 return LLVMLabelTypeInContext(Context);
387387 }
388388
389 CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
390 {
391 CAMLparam1(Name);
392 LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
393 if (Ty) {
394 value Option = alloc(1, 0);
395 Field(Option, 0) = (value) Ty;
396 CAMLreturn(Option);
397 }
398 CAMLreturn(Val_int(0));
399 }
400
389401 /*===-- VALUES ------------------------------------------------------------===*/
390402
391403 /* llvalue -> lltype */
10971109 DEFINE_ITERATORS(
10981110 block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
10991111
1112 /* llbasicblock -> llvalue option */
1113 CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
1114 {
1115 CAMLparam0();
1116 LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
1117 if (Term) {
1118 value Option = alloc(1, 0);
1119 Field(Option, 0) = (value) Term;
1120 CAMLreturn(Option);
1121 }
1122 CAMLreturn(Val_int(0));
1123 }
1124
11001125 /* llvalue -> llbasicblock array */
11011126 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
11021127 value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
12311256 CAMLreturn(Tl);
12321257 }
12331258
1259 /* llvalue -> unit */
1260 CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
1261 LLVMInstructionEraseFromParent(Instruction);
1262 return Val_unit;
1263 }
12341264
12351265 /*===-- Instruction builders ----------------------------------------------===*/
12361266
13581388 return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
13591389 }
13601390
1391 /* lltype -> string -> llbuilder -> llvalue */
1392 CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
1393 value B)
1394 {
1395 return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
1396 }
1397
1398 /* lltype -> llvalue -> string -> llbuilder -> llvalue */
1399 CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
1400 LLVMValueRef Val,
1401 value Name, value B)
1402 {
1403 return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
1404 }
1405
1406 /* llvalue -> llbuilder -> llvalue */
1407 CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
1408 {
1409 return LLVMBuildFree(Builder_val(B), P);
1410 }
1411
13611412 /* llvalue -> llvalue -> llbasicblock -> unit */
13621413 CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
13631414 LLVMBasicBlockRef Dest) {
13981449 Args[4], Args[5]);
13991450 }
14001451
1452 /* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
14011453 CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
14021454 value NumClauses, value Name,
14031455 value B) {
14051457 String_val(Name));
14061458 }
14071459
1460 /* llvalue -> llvalue -> unit */
1461 CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
1462 {
1463 LLVMAddClause(LandingPadInst, ClauseVal);
1464 return Val_unit;
1465 }
1466
1467
1468 /* llvalue -> bool -> unit */
14081469 CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
14091470 {
14101471 LLVMSetCleanup(LandingPadInst, Bool_val(flag));
14111472 return Val_unit;
1473 }
1474
1475 /* llvalue -> llbuilder -> llvalue */
1476 CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
1477 {
1478 return LLVMBuildResume(Builder_val(B), Exn);
14121479 }
14131480
14141481 /* llbuilder -> llvalue */
1919 external
2020 add_scalar_repl_aggregation : [ unit
2121 = "llvm_add_scalar_repl_aggregation"
22
23 external
24 add_scalar_repl_aggregation_ssa : [ unit
25 = "llvm_add_scalar_repl_aggregation_ssa"
26
27 external
28 add_scalar_repl_aggregation_with_threshold : int -> [
29 -> unit
30 = "llvm_add_scalar_repl_aggregation_with_threshold"
2231 external add_ind_var_simplification : [
2332 -> unit
2433 = "llvm_add_ind_var_simplification"
6675 external add_loop_deletion : [
6776 -> unit
6877 = "llvm_add_loop_deletion"
78
79 external add_loop_idiom : [
80 -> unit
81 = "llvm_add_loop_idiom"
82
6983 external
7084 add_lib_call_simplification : [ unit
7185 = "llvm_add_lib_call_simplification"
86
87 external
88 add_verifier : [ unit
89 = "llvm_add_verifier"
90
91 external
92 add_correlated_value_propagation : [ unit
93 = "llvm_add_correlated_value_propagation"
94
95 external
96 add_early_cse : [ unit
97 = "llvm_add_early_cse"
98
99 external
100 add_lower_expect_intrinsic : [ unit
101 = "llvm_add_lower_expect_intrinsic"
102
103 external
104 add_type_based_alias_analysis : [ unit
105 = "llvm_add_type_based_alias_analysis"
106
107 external
108 add_basic_alias_analysis : [ unit
109 = "llvm_add_basic_alias_analysis"
110
3333 external
3434 add_scalar_repl_aggregation : [ unit
3535 = "llvm_add_scalar_repl_aggregation"
36
37 (** See the [llvm::createScalarReplAggregatesPassSSA] function. *)
38 external
39 add_scalar_repl_aggregation_ssa : [ unit
40 = "llvm_add_scalar_repl_aggregation_ssa"
41
42 (** See the [llvm::createScalarReplAggregatesWithThreshold] function. *)
43 external
44 add_scalar_repl_aggregation_with_threshold : int -> [
45 -> unit
46 = "llvm_add_scalar_repl_aggregation_with_threshold"
3647
3748 (** See the [llvm::createIndVarSimplifyPass] function. *)
3849 external add_ind_var_simplification : [
111122 -> unit
112123 = "llvm_add_loop_deletion"
113124
125 external add_loop_idiom : [
126 -> unit
127 = "llvm_add_loop_idiom"
128
114129 (** See the [llvm::createSimplifyLibCallsPass] function. *)
115130 external
116131 add_lib_call_simplification : [ unit
117132 = "llvm_add_lib_call_simplification"
133
134 (** See the [llvm::createVerifierPass] function. *)
135 external
136 add_verifier : [ unit
137 = "llvm_add_verifier"
138
139 (** See the [llvm::createCorrelatedValuePropagationPass] function. *)
140 external
141 add_correlated_value_propagation : [ unit
142 = "llvm_add_correlated_value_propagation"
143
144 (** See the [llvm::createEarlyCSE] function. *)
145 external
146 add_early_cse : [ unit
147 = "llvm_add_early_cse"
148
149 (** See the [llvm::createLowerExpectIntrinsicPass] function. *)
150 external
151 add_lower_expect_intrinsic : [ unit
152 = "llvm_add_lower_expect_intrinsic"
153
154 (** See the [llvm::createTypeBasedAliasAnalysisPass] function. *)
155 external
156 add_type_based_alias_analysis : [ unit
157 = "llvm_add_type_based_alias_analysis"
158
159 (** See the [llvm::createBasicAliasAnalysisPass] function. *)
160 external
161 add_basic_alias_analysis : [ unit
162 = "llvm_add_basic_alias_analysis"
163
4949 }
5050
5151 /* [ unit */
52 CAMLprim value llvm_add_scalar_repl_aggregation_ssa(LLVMPassManagerRef PM) {
53 LLVMAddScalarReplAggregatesPassSSA(PM);
54 return Val_unit;
55 }
56
57 /* [ int -> unit */
58 CAMLprim value llvm_add_scalar_repl_aggregation_with_threshold(value threshold,
59 LLVMPassManagerRef PM) {
60 LLVMAddScalarReplAggregatesPassWithThreshold(PM, Int_val(threshold));
61 return Val_unit;
62 }
63
64 /* [ unit */
5265 CAMLprim value llvm_add_ind_var_simplification(LLVMPassManagerRef PM) {
5366 LLVMAddIndVarSimplifyPass(PM);
5467 return Val_unit;
6881
6982 /* [ unit */
7083 CAMLprim value llvm_add_loop_unswitch(LLVMPassManagerRef PM) {
71 LLVMAddLoopUnrollPass(PM);
84 LLVMAddLoopUnswitchPass(PM);
7285 return Val_unit;
7386 }
7487
139152 }
140153
141154 /* [ unit */
155 CAMLprim value llvm_add_loop_idiom(LLVMPassManagerRef PM) {
156 LLVMAddLoopIdiomPass(PM);
157 return Val_unit;
158 }
159
160 /* [ unit */
142161 CAMLprim value llvm_add_lib_call_simplification(LLVMPassManagerRef PM) {
143162 LLVMAddSimplifyLibCallsPass(PM);
144163 return Val_unit;
145164 }
165
166 /* [ unit */
167 CAMLprim value llvm_add_verifier(LLVMPassManagerRef PM) {
168 LLVMAddVerifierPass(PM);
169 return Val_unit;
170 }
171
172 /* [ unit */
173 CAMLprim value llvm_add_correlated_value_propagation(LLVMPassManagerRef PM) {
174 LLVMAddCorrelatedValuePropagationPass(PM);
175 return Val_unit;
176 }
177
178 /* [ unit */
179 CAMLprim value llvm_add_early_cse(LLVMPassManagerRef PM) {
180 LLVMAddEarlyCSEPass(PM);
181 return Val_unit;
182 }
183
184 /* [ unit */
185 CAMLprim value llvm_add_lower_expect_intrinsic(LLVMPassManagerRef PM) {
186 LLVMAddLowerExpectIntrinsicPass(PM);
187 return Val_unit;
188 }
189
190 /* [ unit */
191 CAMLprim value llvm_add_type_based_alias_analysis(LLVMPassManagerRef PM) {
192 LLVMAddTypeBasedAliasAnalysisPass(PM);
193 return Val_unit;
194 }
195
196 /* [ unit */
197 CAMLprim value llvm_add_basic_alias_analysis(LLVMPassManagerRef PM) {
198 LLVMAddBasicAliasAnalysisPass(PM);
199 return Val_unit;
200 }
4141
4242 ignore (PassManager.create_function m
4343 ++ TargetData.add td
44 ++ add_verifier
4445 ++ add_constant_propagation
4546 ++ add_sccp
4647 ++ add_dead_store_elimination
4748 ++ add_aggressive_dce
4849 ++ add_scalar_repl_aggregation
50 ++ add_scalar_repl_aggregation_ssa
51 ++ add_scalar_repl_aggregation_with_threshold 4
4952 ++ add_ind_var_simplification
5053 ++ add_instruction_combination
5154 ++ add_licm
6164 ++ add_gvn
6265 ++ add_memcpy_opt
6366 ++ add_loop_deletion
67 ++ add_loop_idiom
6468 ++ add_lib_call_simplification
69 ++ add_correlated_value_propagation
70 ++ add_early_cse
71 ++ add_lower_expect_intrinsic
72 ++ add_type_based_alias_analysis
73 ++ add_basic_alias_analysis
74 ++ add_verifier
6575 ++ PassManager.initialize
6676 ++ PassManager.run_function fn
6777 ++ PassManager.finalize
856856 let bb00 = append_block context "Bb00" fn in
857857 ignore (build_unreachable (builder_at_end context bb00));
858858
859 group "function attribute";
860 begin
861 ignore (add_function_attr fn Attribute.UWTable);
862 (* RUN: grep "X7.*uwtable" < %t.ll
863 *)
864 insist ([Attribute.UWTable] = function_attr fn);
865 end;
866
859867 (* see test/Feature/exception.ll *)
860868 let bblpad = append_block context "Bblpad" fn in
861869 let rt = struct_type context [| pointer_type i8_type; i32_type |] in
871879 let lp = build_landingpad rt personality 0 "lpad"
872880 (builder_at_end context bblpad) in begin
873881 set_cleanup lp true;
874 ignore (build_unreachable (builder_at_end context bblpad));
882 add_clause lp ztic;
883 insist((pointer_type (pointer_type i8_type)) = type_of ztid);
884 let ety = pointer_type (pointer_type i8_type) in
885 add_clause lp (const_array ety [| ztipkc; ztid |]);
886 ignore (build_resume lp (builder_at_end context bblpad));
875887 end;
876888 (* RUN: grep "landingpad.*personality.*__gxx_personality_v0" < %t.ll
877889 * RUN: grep "cleanup" < %t.ll
890 * RUN: grep "catch.*i8\*\*.*@_ZTIc" < %t.ll
891 * RUN: grep "filter.*@_ZTIPKc.*@_ZTId" < %t.ll
892 * RUN: grep "resume " < %t.ll
878893 * *)
879894 end;
880895
913928 ignore (build_unreachable (builder_at_end context bb3));
914929 let si = build_switch p1 bb3 1 (builder_at_end context bb1) in begin
915930 ignore (add_case si (const_int i32_type 2) bb2);
931 insist (switch_default_dest si = bb3);
916932 end;
933 end;
934
935 group "malloc/free"; begin
936 (* RUN: grep {call.*@malloc(i32 ptrtoint} < %t.ll
937 * RUN: grep {call.*@free(i8\*} < %t.ll
938 * RUN: grep {call.*@malloc(i32 %} < %t.ll
939 *)
940 let bb1 = append_block context "MallocBlock1" fn in
941 let m1 = (build_malloc (pointer_type i32_type) "m1"
942 (builder_at_end context bb1)) in
943 ignore (build_free m1 (builder_at_end context bb1));
944 ignore (build_array_malloc i32_type p1 "m2" (builder_at_end context bb1));
945 ignore (build_unreachable (builder_at_end context bb1));
917946 end;
918947
919948 group "indirectbr"; begin