[llvm-ocaml] Add LLVMBuildCall2 binding

Add binding for the opaque pointer compatible LLVMBuildCall2
API and use it in tests.
This commit is contained in:
Nikita Popov 2022-06-02 10:22:59 +02:00
parent 4b13b061ae
commit 3ed6fc9a69
7 changed files with 29 additions and 18 deletions

View File

@ -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

View File

@ -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].

View File

@ -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) {

View File

@ -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);

View File

@ -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

View File

@ -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

View File

@ -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 ()