[OCaml][DebugInfo] Add bindings for parameter and auto variable creation

[vaivaswatha]

Summary

This patch extends https://reviews.llvm.org/D90831 with a few more functions added to the OCaml debuginfo bindings.

[jberdine]

LGTM, though I would prefer if docstrings were added for each of the functions added to llvm_debuginfo.mli.

[vaivaswatha]

Add inline docs for the newly added functions in the .mli file.

[vaivaswatha]

In D123914#3470145, @jberdine wrote:

LGTM, though I would prefer if docstrings were added for each of the functions added to llvm_debuginfo.mli.

Thank you @jberdine . I have now added the docstrings (it had skipped my mind entirely, thank you for noticing).

llvm/bindings/ocaml/debuginfo/debuginfo_ocaml.c

 
 value llvm_di_variable_get_file(LLVMMetadataRef Variable) {
   return (ptr_to_option(LLVMDIVariableGetFile(Variable)));
 }
 
 value llvm_get_metadata_kind(LLVMMetadataRef Metadata) {
   return Val_int(LLVMGetMetadataKind(Metadata));
 }
+
+LLVMMetadataRef llvm_dibuild_create_auto_variable_native(
+    value Builder, LLVMMetadataRef Scope, value Name, LLVMMetadataRef File,
+    value Line, LLVMMetadataRef Ty, value AlwaysPreserve, value Flags,
+    value AlignInBits) {
+  return LLVMDIBuilderCreateAutoVariable(
+      DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name),
+      File, Int_val(Line), Ty, Bool_val(AlwaysPreserve), DIFlags_val(Flags),
+      Int_val(AlignInBits));
+}
+
+LLVMMetadataRef llvm_dibuild_create_auto_variable_bytecode(value *argv,
+                                                           int arg) {
+
+  return llvm_dibuild_create_auto_variable_native(
+      argv[0],                  // Builder
+      (LLVMMetadataRef)argv[1], // Scope
+      argv[2],                  // Name
+      (LLVMMetadataRef)argv[3], // File
+      argv[4],                  // Line
+      (LLVMMetadataRef)argv[5], // Ty
+      argv[6],                  // AlwaysPreserve
+      argv[7],                  // Flags
+      argv[8]                   // AlignInBits
+  );
+}
+
+LLVMMetadataRef llvm_dibuild_create_parameter_variable_native(
+    value Builder, LLVMMetadataRef Scope, value Name, unsigned ArgNo,
+    LLVMMetadataRef File, value Line, LLVMMetadataRef Ty, value AlwaysPreserve,
+    value Flags) {
+  return LLVMDIBuilderCreateParameterVariable(
+      DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name),
+      ArgNo, File, Int_val(Line), Ty, Bool_val(AlwaysPreserve),
+      DIFlags_val(Flags));
+}
+
+LLVMMetadataRef llvm_dibuild_create_parameter_variable_bytecode(value *argv,
+                                                                int arg) {
+
+  return llvm_dibuild_create_parameter_variable_native(
+      argv[0],                  // Builder
+      (LLVMMetadataRef)argv[1], // Scope
+      argv[2],                  // Name
+      argv[3],                  // ArgNo
+      (LLVMMetadataRef)argv[4], // File
+      argv[5],                  // Line
+      (LLVMMetadataRef)argv[6], // Ty
+      argv[7],                  // AlwaysPreserve
+      argv[8]                   // Flags
+  );
+}
+
+LLVMValueRef llvm_dibuild_insert_declare_before_native(
+    value Builder, LLVMValueRef Storage, LLVMMetadataRef VarInfo,
+    LLVMMetadataRef Expr, LLVMMetadataRef DebugLoc, LLVMValueRef Instr) {
+  return LLVMDIBuilderInsertDeclareBefore(DIBuilder_val(Builder), Storage,
+                                          VarInfo, Expr, DebugLoc, Instr);
+}
+
+LLVMValueRef llvm_dibuild_insert_declare_before_bytecode(value *argv, int arg) {
+
+  return llvm_dibuild_insert_declare_before_native(
+      argv[0],                  // Builder
+      (LLVMValueRef)argv[1],    // Storage
+      (LLVMMetadataRef)argv[2], // VarInfo
+      (LLVMMetadataRef)argv[3], // Expr
+      (LLVMMetadataRef)argv[4], // DebugLoc
+      (LLVMValueRef)argv[5]     // Instr
+  );
+}
+
+LLVMValueRef llvm_dibuild_insert_declare_at_end_native(
+    value Builder, LLVMValueRef Storage, LLVMMetadataRef VarInfo,
+    LLVMMetadataRef Expr, LLVMMetadataRef DebugLoc, LLVMBasicBlockRef Block) {
+  return LLVMDIBuilderInsertDeclareAtEnd(DIBuilder_val(Builder), Storage,
+                                         VarInfo, Expr, DebugLoc, Block);
+}
+
+LLVMValueRef llvm_dibuild_insert_declare_at_end_bytecode(value *argv, int arg) {
+
+  return llvm_dibuild_insert_declare_at_end_native(
+      argv[0],                   // Builder
+      (LLVMValueRef)argv[1],     // Storage
+      (LLVMMetadataRef)argv[2],  // VarInfo
+      (LLVMMetadataRef)argv[3],  // Expr
+      (LLVMMetadataRef)argv[4],  // DebugLoc
+      (LLVMBasicBlockRef)argv[5] // Block
+  );
+}
+
+LLVMMetadataRef llvm_dibuild_expression(value Builder, value Addr) {
+  return LLVMDIBuilderCreateExpression(
+      DIBuilder_val(Builder), (uint64_t *)Op_val(Addr), Wosize_val(Addr));
+}

llvm/bindings/ocaml/debuginfo/llvm_debuginfo.ml

 external di_variable_get_line : Llvm.llmetadata -> int
   = "llvm_di_variable_get_line"
 
 external di_variable_get_file : Llvm.llmetadata -> Llvm.llmetadata option
   = "llvm_di_variable_get_file"
 
 external get_metadata_kind : Llvm.llmetadata -> MetadataKind.t
   = "llvm_get_metadata_kind"
+
+external dibuild_create_auto_variable :
+  lldibuilder ->
+  scope:Llvm.llmetadata ->
+  name:string ->
+  file:Llvm.llmetadata ->
+  line:int ->
+  ty:Llvm.llmetadata ->
+  always_preserve:bool ->
+  lldiflags ->
+  align_in_bits:int ->
+  Llvm.llmetadata
+  = "llvm_dibuild_create_auto_variable_bytecode" "llvm_dibuild_create_auto_variable_native"
+
+external dibuild_create_parameter_variable :
+  lldibuilder ->
+  scope:Llvm.llmetadata ->
+  name:string ->
+  argno:int ->
+  file:Llvm.llmetadata ->
+  line:int ->
+  ty:Llvm.llmetadata ->
+  always_preserve:bool ->
+  lldiflags ->
+  Llvm.llmetadata
+  = "llvm_dibuild_create_parameter_variable_bytecode" "llvm_dibuild_create_parameter_variable_native"
+
+external dibuild_insert_declare_before :
+  lldibuilder ->
+  storage:Llvm.llvalue ->
+  var_info:Llvm.llmetadata ->
+  expr:Llvm.llmetadata ->
+  location:Llvm.llmetadata ->
+  instr:Llvm.llvalue ->
+  Llvm.llvalue
+  = "llvm_dibuild_insert_declare_before_bytecode" "llvm_dibuild_insert_declare_before_native"
+
+external dibuild_insert_declare_at_end :
+  lldibuilder ->
+  storage:Llvm.llvalue ->
+  var_info:Llvm.llmetadata ->
+  expr:Llvm.llmetadata ->
+  location:Llvm.llmetadata ->
+  block:Llvm.llbasicblock ->
+  Llvm.llvalue
+  = "llvm_dibuild_insert_declare_at_end_bytecode" "llvm_dibuild_insert_declare_at_end_native"
+
+external dibuild_expression :
+  lldibuilder ->
+  Int64.t array ->
+  Llvm.llmetadata
+  = "llvm_dibuild_expression"

llvm/bindings/ocaml/debuginfo/llvm_debuginfo.mli

 (** [instr_get_debug_loc i] Get the debug location for instruction [i]. *)
 
 val instr_set_debug_loc : Llvm.llvalue -> Llvm.llmetadata option -> unit
 (** [instr_set_debug_loc i mopt] If [mopt] is None location metadata of [i]
     is cleared, Otherwise location of [i] is set to the value in [mopt]. *)
 
 val get_metadata_kind : Llvm.llmetadata -> MetadataKind.t
 (** [get_metadata_kind] Obtain the enumerated type of a Metadata instance. *)
+
+val dibuild_create_auto_variable :
+  lldibuilder ->
+  scope:Llvm.llmetadata ->
+  name:string ->
+  file:Llvm.llmetadata ->
+  line:int ->
+  ty:Llvm.llmetadata ->
+  always_preserve:bool ->
+  lldiflags ->
+  align_in_bits:int ->
+  Llvm.llmetadata
+(** [dibuild_create_auto_variable] Create a new descriptor for a
+    local auto variable. *)
+
+val dibuild_create_parameter_variable :
+  lldibuilder ->
+  scope:Llvm.llmetadata ->
+  name:string ->
+  argno:int ->
+  file:Llvm.llmetadata ->
+  line:int ->
+  ty:Llvm.llmetadata ->
+  always_preserve:bool ->
+  lldiflags ->
+  Llvm.llmetadata
+(** [dibuild_create_parameter_variable] Create a new descriptor for a
+    function parameter variable. *)
+
+val dibuild_insert_declare_before :
+  lldibuilder ->
+  storage:Llvm.llvalue ->
+  var_info:Llvm.llmetadata ->
+  expr:Llvm.llmetadata ->
+  location:Llvm.llmetadata ->
+  instr:Llvm.llvalue ->
+  Llvm.llvalue
+(** [dibuild_insert_declare_before]  Insert a new llvm.dbg.declare
+    intrinsic call before the given instruction [instr]. *)
+
+val dibuild_insert_declare_at_end :
+  lldibuilder ->
+  storage:Llvm.llvalue ->
+  var_info:Llvm.llmetadata ->
+  expr:Llvm.llmetadata ->
+  location:Llvm.llmetadata ->
+  block:Llvm.llbasicblock ->
+  Llvm.llvalue
+(** [dibuild_insert_declare_at_end] Insert a new llvm.dbg.declare
+    intrinsic call at the end of basic block [block]. If [block]
+    has a terminator instruction, the intrinsic is inserted
+    before that terminator instruction. *)
+
+val dibuild_expression : lldibuilder -> Int64.t array -> Llvm.llmetadata
+(** [dibuild_expression] Create a new descriptor for the specified variable
+    which has a complex address expression for its address.
+    See LLVMDIBuilderCreateExpression. *)

llvm/test/Bindings/OCaml/debuginfo.ml

| Some gvexpr_var_di ->
       (* CHECK: [[GV_PTR:<0x[0-9a-f]*>]] = distinct !DIGlobalVariable(name: "my_global", scope: [[MODULE_PTR]], file: [[FILE_PTR]], line: 5, type: [[INT64TY_PTR]], isLocal: true, isDefinition: true)
        *)
   | None -> insist false );
   stdout_metadata gvexpr_di;
   (* CHECK: [[GVEXP_PTR:<0x[0-9a-f]*>]] = !DIGlobalVariableExpression(var: [[GV_PTR]], expr: [[DICEXPR]])
    *)
   ()
 
+let test_variables f dibuilder file_di fun_di =
+  let entry_term = Option.get @@ (Llvm.block_terminator (Llvm.entry_block f)) in
+  group "Local and parameter variable tests";
+  let ty = int_ty_di 64 dibuilder in
+  stdout_metadata ty;
+  (* CHECK: [[INT64TY_PTR:<0x[0-9a-f]*>]] = !DIBasicType(name: "int", size: 64, encoding: DW_ATE_signed)
+  *)
+  let auto_var =
+    Llvm_debuginfo.dibuild_create_auto_variable dibuilder ~scope:fun_di
+      ~name:"my_local" ~file:file_di ~line:10 ~ty
+      ~always_preserve:false flags_zero ~align_in_bits:0
+  in
+  stdout_metadata auto_var;
+  (* CHECK: [[LOCAL_VAR_PTR:<0x[0-9a-f]*>]] = !DILocalVariable(name: "my_local", scope: <{{0x[0-9a-f]*}}>, file: <{{0x[0-9a-f]*}}>, line: 10, type: [[INT64TY_PTR]])
+  *)
+  let builder = Llvm.builder_before context entry_term in
+  let all = Llvm.build_alloca (Llvm.i64_type context)  "my_alloca" builder in
+  let scope =
+    Llvm_debuginfo.dibuild_create_lexical_block dibuilder ~scope:fun_di
+      ~file:file_di ~line:9 ~column:4
+  in
+  let location =
+    Llvm_debuginfo.dibuild_create_debug_location
+    context ~line:10 ~column:12 ~scope
+  in
+  let vdi = Llvm_debuginfo.dibuild_insert_declare_before dibuilder ~storage:all
+    ~var_info:auto_var ~expr:(Llvm_debuginfo.dibuild_expression dibuilder [||])
+    ~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]+}}
+  *)
+  let arg0 = (Llvm.params f).(0) in
+  let arg_var = Llvm_debuginfo.dibuild_create_parameter_variable dibuilder ~scope:fun_di
+    ~name:"my_arg" ~argno:0 ~file:file_di ~line:10 ~ty
+    ~always_preserve:false flags_zero
+  in
+  let argdi = Llvm_debuginfo.dibuild_insert_declare_before dibuilder ~storage:arg0
+    ~var_info:arg_var ~expr:(Llvm_debuginfo.dibuild_expression dibuilder [||])
+    ~location ~instr:entry_term
+  in
+  let () = Printf.printf "%s\n" (Llvm.string_of_llvalue argdi) in
+  (* CHECK: call void @llvm.dbg.declare(metadata i32 %0, metadata {{![0-9]+}}, metadata !DIExpression()), !dbg {{\![0-9]+}}
+  *)
+  ()
+
 let test_types dibuilder file_di m_di =
   group "type tests";
   let namespace_di =
     Llvm_debuginfo.dibuild_create_namespace dibuilder ~parent_ref:m_di
       ~name:"NameSpace1" ~export_symbols:false
   in
   stdout_metadata namespace_di;
   (* CHECK: [[NAMESPACE_PTR:<0x[0-9a-f]*>]] = !DINamespace(name: "NameSpace1", scope: [[MODULE_PTR]])
insist
     = Llvm_debuginfo.MetadataKind.DICompositeTypeMetadataKind );
   ()
 
 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 () = 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
   Llvm_debuginfo.dibuild_finalize dibuilder;
   ( match Llvm_analysis.verify_module m with
   | Some err ->
       prerr_endline ("Verification of module failed: " ^ err);
       exit_status := 1
   | None -> () );
   exit !exit_status