forked from OSchip/llvm-project
[llvm-ocaml] Add LLVMBuildCall2 binding
Add binding for the opaque pointer compatible LLVMBuildCall2 API and use it in tests.
This commit is contained in:
parent
4b13b061ae
commit
3ed6fc9a69
|
@ -1370,6 +1370,8 @@ external build_empty_phi : lltype -> string -> llbuilder -> llvalue
|
|||
= "llvm_build_empty_phi"
|
||||
external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
|
||||
= "llvm_build_call"
|
||||
external build_call2 : lltype -> llvalue -> llvalue array -> string ->
|
||||
llbuilder -> llvalue = "llvm_build_call2"
|
||||
external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder ->
|
||||
llvalue = "llvm_build_select"
|
||||
external build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue
|
||||
|
|
|
@ -2583,6 +2583,13 @@ val build_empty_phi : lltype -> string -> llbuilder -> llvalue
|
|||
See the method [llvm::LLVMBuilder::CreateCall]. *)
|
||||
val build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
|
||||
|
||||
(** [build_call2 fnty fn args name b] creates a
|
||||
[%name = call %fn(args...)]
|
||||
instruction at the position specified by the instruction builder [b].
|
||||
See the method [llvm::LLVMBuilder::CreateCall]. *)
|
||||
val build_call2 : lltype -> llvalue -> llvalue array -> string -> llbuilder ->
|
||||
llvalue
|
||||
|
||||
(** [build_select cond thenv elsev name b] creates a
|
||||
[%name = select %cond, %thenv, %elsev]
|
||||
instruction at the position specified by the instruction builder [b].
|
||||
|
|
|
@ -2245,6 +2245,14 @@ LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params, value Name,
|
|||
Wosize_val(Params), String_val(Name));
|
||||
}
|
||||
|
||||
/* lltype -> llvalue -> llvalue array -> string -> llbuilder -> llvalue */
|
||||
LLVMValueRef llvm_build_call2(LLVMTypeRef FnTy, LLVMValueRef Fn, value Params,
|
||||
value Name, value B) {
|
||||
return LLVMBuildCall2(Builder_val(B), FnTy, Fn,
|
||||
(LLVMValueRef *)Op_val(Params), Wosize_val(Params),
|
||||
String_val(Name));
|
||||
}
|
||||
|
||||
/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
|
||||
LLVMValueRef llvm_build_select(LLVMValueRef If, LLVMValueRef Then,
|
||||
LLVMValueRef Else, value Name, value B) {
|
||||
|
|
|
@ -37,9 +37,6 @@ let m = create_module context filename
|
|||
(*===-- Contained types --------------------------------------------------===*)
|
||||
|
||||
let test_contained_types () =
|
||||
let pointer_i32 = pointer_type i32_type in
|
||||
insist (i32_type = (Array.get (subtypes pointer_i32) 0));
|
||||
|
||||
let ar = struct_type context [| i32_type; i8_type |] in
|
||||
insist (i32_type = (Array.get (subtypes ar)) 0);
|
||||
insist (i8_type = (Array.get (subtypes ar)) 1)
|
||||
|
@ -1100,7 +1097,7 @@ let test_builder () =
|
|||
* CHECK: %build_insertvalue0 = insertvalue{{.*}}%bl, i32 1, 0
|
||||
* CHECK: %build_extractvalue = extractvalue{{.*}}%build_insertvalue1, 1
|
||||
*)
|
||||
let ci = build_call fn [| p2; p1 |] "build_call" atentry in
|
||||
let ci = build_call2 fty fn [| p2; p1 |] "build_call" atentry in
|
||||
insist (CallConv.c = instruction_call_conv ci);
|
||||
set_instruction_call_conv 63 ci;
|
||||
insist (63 = instruction_call_conv ci);
|
||||
|
|
|
@ -152,9 +152,9 @@ let test_get_function m dibuilder file_di m_di =
|
|||
( Llvm_debuginfo.get_metadata_kind f_di
|
||||
= Llvm_debuginfo.MetadataKind.DISubprogramMetadataKind );
|
||||
insist (Llvm_debuginfo.di_subprogram_get_line f_di = 10);
|
||||
(f, f_di)
|
||||
(fty, f, f_di)
|
||||
|
||||
let test_bbinstr f f_di file_di dibuilder =
|
||||
let test_bbinstr fty f f_di file_di dibuilder =
|
||||
group "basic_block and instructions tests";
|
||||
(* Create this pattern:
|
||||
* if (arg0 != 0) {
|
||||
|
@ -169,11 +169,7 @@ let test_bbinstr f f_di file_di dibuilder =
|
|||
let truebb = Llvm.append_block context "truebb" f in
|
||||
let falsebb = Llvm.append_block context "falsebb" f in
|
||||
let _ = Llvm.build_cond_br cmpi truebb falsebb builder in
|
||||
let foodecl =
|
||||
Llvm.declare_function "foo"
|
||||
(Llvm.element_type (Llvm.type_of f))
|
||||
(Llvm.global_parent f)
|
||||
in
|
||||
let foodecl = Llvm.declare_function "foo" fty (Llvm.global_parent f) in
|
||||
let _ =
|
||||
Llvm.position_at_end truebb builder;
|
||||
let scope =
|
||||
|
@ -187,7 +183,7 @@ let test_bbinstr f f_di file_di dibuilder =
|
|||
| Some file_of_f_di', Some file_of_scope' ->
|
||||
file_of_f_di' = file_di && file_of_scope' = file_di
|
||||
| _ -> false );
|
||||
let foocall = Llvm.build_call foodecl [| arg0 |] "" builder in
|
||||
let foocall = Llvm.build_call2 fty foodecl [| arg0 |] "" builder in
|
||||
let foocall_loc =
|
||||
Llvm_debuginfo.dibuild_create_debug_location context ~line:10 ~column:12
|
||||
~scope
|
||||
|
@ -290,7 +286,7 @@ let test_variables f dibuilder file_di fun_di =
|
|||
~location ~instr:entry_term
|
||||
in
|
||||
let () = Printf.printf "%s\n" (Llvm.string_of_llvalue vdi) in
|
||||
(* CHECK: call void @llvm.dbg.declare(metadata i64* %my_alloca, metadata {{![0-9]+}}, metadata !DIExpression()), !dbg {{\![0-9]+}}
|
||||
(* CHECK: call void @llvm.dbg.declare(metadata ptr %my_alloca, metadata {{![0-9]+}}, metadata !DIExpression()), !dbg {{\![0-9]+}}
|
||||
*)
|
||||
let arg0 = (Llvm.params f).(0) in
|
||||
let arg_var = Llvm_debuginfo.dibuild_create_parameter_variable dibuilder ~scope:fun_di
|
||||
|
@ -446,8 +442,8 @@ let test_types dibuilder file_di m_di =
|
|||
|
||||
let () =
|
||||
let m, dibuilder, file_di, m_di = test_get_module () in
|
||||
let f, fun_di = test_get_function m dibuilder file_di m_di in
|
||||
let () = test_bbinstr f fun_di file_di dibuilder in
|
||||
let fty, f, fun_di = test_get_function m dibuilder file_di m_di in
|
||||
let () = test_bbinstr fty f fun_di file_di dibuilder in
|
||||
let () = test_global_variable_expression dibuilder file_di m_di in
|
||||
let () = test_variables f dibuilder file_di fun_di in
|
||||
let () = test_types dibuilder file_di m_di in
|
||||
|
|
|
@ -28,9 +28,10 @@ let bomb msg =
|
|||
exit 2
|
||||
|
||||
let define_getglobal m pg =
|
||||
let fn = define_function "getglobal" (function_type i32_type [||]) m in
|
||||
let fty = function_type i32_type [||] in
|
||||
let fn = define_function "getglobal" fty m in
|
||||
let b = builder_at_end (global_context ()) (entry_block fn) in
|
||||
let g = build_call pg [||] "" b in
|
||||
let g = build_call2 fty pg [||] "" b in
|
||||
ignore (build_ret g b);
|
||||
fn
|
||||
|
||||
|
|
|
@ -43,7 +43,7 @@ let test_transforms () =
|
|||
let fn2 = define_function "fn2" fty m in begin
|
||||
ignore (build_ret (const_int i8_type 4) (builder_at_end context (entry_block fn)));
|
||||
let b = builder_at_end context (entry_block fn2) in
|
||||
ignore (build_ret (build_call fn [| |] "" b) b);
|
||||
ignore (build_ret (build_call2 fty fn [| |] "" b) b);
|
||||
end;
|
||||
|
||||
ignore (PassManager.create ()
|
||||
|
|
Loading…
Reference in New Issue