Skip to content

Commit

Permalink
[llvm-ocaml] Add LLVMBuildCall2 binding
Browse files Browse the repository at this point in the history
Add binding for the opaque pointer compatible LLVMBuildCall2
API and use it in tests.
  • Loading branch information
nikic committed Jun 2, 2022
1 parent 4b13b06 commit 3ed6fc9
Show file tree
Hide file tree
Showing 7 changed files with 29 additions and 18 deletions.
2 changes: 2 additions & 0 deletions llvm/bindings/ocaml/llvm/llvm.ml
Expand Up @@ -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
Expand Down
7 changes: 7 additions & 0 deletions llvm/bindings/ocaml/llvm/llvm.mli
Expand Up @@ -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].
Expand Down
8 changes: 8 additions & 0 deletions llvm/bindings/ocaml/llvm/llvm_ocaml.c
Expand Up @@ -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) {
Expand Down
5 changes: 1 addition & 4 deletions llvm/test/Bindings/OCaml/core.ml
Expand Up @@ -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)
Expand Down Expand Up @@ -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);
Expand Down
18 changes: 7 additions & 11 deletions llvm/test/Bindings/OCaml/debuginfo.ml
Expand Up @@ -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) {
Expand All @@ -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 =
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
5 changes: 3 additions & 2 deletions llvm/test/Bindings/OCaml/executionengine.ml
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion llvm/test/Bindings/OCaml/ipo.ml
Expand Up @@ -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 ()
Expand Down

0 comments on commit 3ed6fc9

Please sign in to comment.