[OCaml] Add OCaml APIs to access DebugLoc info

[jberdine]

Summary

Add thin shims to OCaml interfaces to provide access to DebugLoc info
for Instructions, GlobalVariables and Functions.

[jberdine]

update re string option

[jberdine]

@whitequark, does this one look mostly straightforward now that the C API is settled?

[whitequark]

bindings/ocaml/llvm/llvm_ocaml.c

873

Is it legal to use CAMLlocal2 in a conditional like this?

[jberdine]

bindings/ocaml/llvm/llvm_ocaml.c

873

No, nice catch! The manual states:

Local variables of type value must be declared with one of the CAMLlocal macros. [...] These macros must be used at the beginning of the function, not in a nested block.

Note that there are a number of existing instances of CAMLlocal in nested blocks in this file. Shall I change them at the same time?

[jberdine]

fix CAMLlocal

[jberdine]

bindings/ocaml/llvm/llvm_ocaml.c

873

Other CAMLlocal changes are in D53841 for reference, I'm happy to merge the patches or not either way.

[jberdine]

@whitequark, could I bother you to commit this for me?

[CodaFi]

@whitequark I meant to comment here, I'm not sure how I wound up on that other issue. Reposting for visibility:

Apologies for not bringing this up in the earlier patch, but is there a reason this isn't using/building on the existing DI C bindings we have?

[jberdine]

@CodaFi, sorry for the delayed reply, I've been busy with other things.

I've been trawling commits since I originally implemented this, and based on your question I'm guessing that you see a way in which the LLVMGetDebugLoc* functions added in D52210 are (partially) redundant? Is it the case that there is redundancy in the C++ interfaces such that the methods called there can be equivalently expressed in terms of generic metadata and DILocations?

Or are you saying that these additions to the ocaml api are already redundant?

[jberdine]

rebase

[jberdine]

I have investigated trying to use LLVMGetMetadata instead of adding LLVMGetDebugLoc* functions, which is my understanding of @CodaFi's question. To summarize my (perhaps incorrect) understanding, on the one hand LLVMGetMetadata calls Instruction::getMetadata which returns Instruction::DbgLoc, a DILocation, cast to MDNode. On the other hand, LLVMGetDebugLocLine calls Instruction::getDebugLoc, a DILocation, and calls DILocation::getLine, which returns DILocation::SubclassData32. It does not seem possible to access that field using the MDNode api. To access such fields would seem to require exposing the class hierarchy below MDNode in LLVM-C. Does that align with your understanding?

[CodaFi]

My concern is that we’re building parallel API hierarchies here. The old hat way of wrapping metadata nodes in a value and casting out to an LLVMValueRef makes no sense if we have APIs to manipulate metadata more directly.

LLVMDILocationGetLine, LLVMDILocationGetColumn, LLVMDILocationGetScope should do what you want, and we should be building accessors for file and directory information on top of those bindings instead of the old LLVMValueRef ones.

[whitequark]

I agree with @CodaFi, it's better to build on LLVMDILocation* functions here, if for no other reason that they are more robust (and not deprecated).

[jberdine]

I agree, parallel APIs are a no-go. I'll rework shortly.

[jberdine]

update to use new DI APIs

[jberdine]

I've updated this to implement the accessors using the new DI APIs instead of the old wrapped value ones, using the functions added in D60489, D60725 and D60795.

There is a big RFC point to this diff: instead of these functions, do we want to work toward a point where the OCaml bindings mirror the C ones, by adding the whole DI type hierarchy, none of which is currently present? I guess so, but would like some others' thoughts.

[jberdine]

bindings/ocaml/llvm/llvm_ocaml.c

887

@CodaFi, is this the filter to find the debug info for a global variable you had in mind?

890

This is the only null check I have not seen fail in practice. It's not a big deal, but I wonder if I am overlooking some reason that guarantees that it is always valid.

896

My understanding is that this deallocation is safe since the returned var already existed in the context, rather than being copied by LLVMGlobalCopyAllMetadata, but a sanity check would be welcome.

[jberdine]

@whitequark I could use some feedback on the direction of this patch relative to https://reviews.llvm.org/D60902. This one implements the accessors for the debug locations directly using the newer DI C bindings. On the other hand D60902 begins adding a hierarchy of types to the OCaml bindings, analogous to the DI hierarchy. This patch gives a more direct implementation for the debug location functions, but the other is more extensible if other DI accessors are needed later. Are either of these approaches acceptable? If not, can you explain briefly why so that I can propose an alternative?

Cc @CodaFi for feedback on the API choices, as experience with the C ones could carry over.

[whitequark]

@jberdine I personally highly prefer the approach in D60902. In general, I believe that the right direction for the OCaml bindings is to evolve towards rich and type-safe accessors.

[jberdine]

Thanks @whitequark , that is very helpful. I'll close this diff in favor of D60902 and continue discussion there.

bindings/ocaml/llvm/llvm.ml

 external mdnull : llcontext -> llvalue = "llvm_mdnull"
 external get_mdstring : llvalue -> string option = "llvm_get_mdstring"
 external get_mdnode_operands : llvalue -> llvalue array
                             = "llvm_get_mdnode_operands"
 external get_named_metadata : llmodule -> string -> llvalue array
                             = "llvm_get_namedmd"
 external add_named_metadata_operand : llmodule -> string -> llvalue -> unit
                                     = "llvm_append_namedmd"
+external get_debug_loc_directory : llvalue -> string option = "llvm_get_debug_loc_directory"
+external get_debug_loc_filename : llvalue -> string option = "llvm_get_debug_loc_filename"
+external get_debug_loc_line : llvalue -> int = "llvm_get_debug_loc_line"
+external get_debug_loc_column : llvalue -> int = "llvm_get_debug_loc_column"
 
 (*--... Operations on scalar constants .....................................--*)
 external const_int : lltype -> int -> llvalue = "llvm_const_int"
 external const_of_int64 : lltype -> Int64.t -> bool -> llvalue
                         = "llvm_const_of_int64"
 external int64_of_const : llvalue -> Int64.t option
                         = "llvm_int64_of_const"
 external const_int_of_string : lltype -> string -> int -> llvalue

bindings/ocaml/llvm/llvm.mli

 
 (** [add_named_metadata_operand m name v] adds [v] as the last operand of
     metadata named [name] in module [m]. If the metadata does not exist,
     it is created.
     See the methods [llvm::Module::getNamedMetadata()] and
     [llvm::MDNode::addOperand()]. *)
 val add_named_metadata_operand : llmodule -> string -> llvalue -> unit
 
+(** [get_debug_loc_directory v] returns the directory of the debug location
+    for [v], which must be an [Instruction], [GlobalVariable], or [Function].
+    See the [llvm::Instruction::getDebugLoc()],
+    [llvm::GlobalVariable::getDebugInfo()], and
+    [llvm::Function::getSubprogram()] methods. *)
+val get_debug_loc_directory : llvalue -> string option
+
+(** [get_debug_loc_filename v] returns the filename of the debug location
+    for [v], which must be an [Instruction], [GlobalVariable], or [Function].
+    See the [llvm::Instruction::getDebugLoc()],
+    [llvm::GlobalVariable::getDebugInfo()], and
+    [llvm::Function::getSubprogram()] methods. *)
+val get_debug_loc_filename : llvalue -> string option
+
+(** [get_debug_loc_line v] returns the line number of the debug location
+    for [v], which must be an [Instruction], [GlobalVariable], or [Function].
+    See the [llvm::Instruction::getDebugLoc()],
+    [llvm::GlobalVariable::getDebugInfo()], and
+    [llvm::Function::getSubprogram()] methods. *)
+val get_debug_loc_line : llvalue -> int
+
+(** [get_debug_loc_column v] returns the column number of the debug location
+    for [v], which must be an [Instruction].
+    See the [llvm::Instruction::getDebugLoc()] method. *)
+val get_debug_loc_column : llvalue -> int
+
 
 (** {7 Operations on scalar constants} *)
 
 (** [const_int ty i] returns the integer constant of type [ty] and value [i].
     See the method [llvm::ConstantInt::get]. *)
 val const_int : lltype -> int -> llvalue
 
 (** [const_of_int64 ty i] returns the integer constant of type [ty] and value

bindings/ocaml/llvm/llvm_ocaml.c

 |* macros, since most of the parameters are not GC heap objects.              *|
 |*                                                                            *|
 \*===----------------------------------------------------------------------===*/
 
 #include <assert.h>
 #include <stdlib.h>
 #include <string.h>
 #include "llvm-c/Core.h"
+#include "llvm-c/DebugInfo.h"
 #include "llvm-c/Support.h"
 #include "llvm/Config/llvm-config.h"
 #include "caml/alloc.h"
 #include "caml/custom.h"
 #include "caml/memory.h"
 #include "caml/fail.h"
 #include "caml/callback.h"
 

 }
 
 /* llmodule -> string -> llvalue -> unit */
 CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef Val) {
   LLVMAddNamedMetadataOperand(M, String_val(Name), Val);
   return Val_unit;
 }
 
+/* Convert a C string with length to an OCaml string option */
+CAMLprim value cstr_to_string_option(const char *Chars, unsigned Length) {
+  CAMLparam0();
+  CAMLlocal2(Option, String);
+  if (Length > 0) {
+    String = caml_alloc_string(Length);
+    memcpy(String_val(String), Chars, Length);
+    Option = caml_alloc_small(1, 0);
+    Store_field(Option, 0, String);
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
+/* Get the DIVariable associated with a GlobalVariable */
+LLVMMetadataRef global_variable_get_divariable(LLVMValueRef GV) {
+  LLVMMetadataRef Var = NULL;
+  size_t NumEntries;
+  LLVMValueMetadataEntry *Entries = LLVMGlobalCopyAllMetadata(GV, &NumEntries);
+  unsigned dbg = LLVMGetMDKindID("dbg", 3);
+  for (int i = 0; i < NumEntries; i++) {
+    if (LLVMValueMetadataEntriesGetKind(Entries, i) == dbg) {
+      LLVMMetadataRef GVE = LLVMValueMetadataEntriesGetMetadata(Entries, i);
+      if (GVE) {
+        Var = LLVMDIGlobalVariableExpressionGetVariable(GVE);
+        break;
+      }
+    }
+  }
+  LLVMDisposeValueMetadataEntries(Entries);
+  return Var;
+}
+
+/* Get the DIFile associated with an Instruction, GlobalVariable, or Function */
+LLVMMetadataRef get_debug_file(LLVMValueRef Val) {
+  LLVMMetadataRef F = NULL;
+  if (LLVMIsAInstruction(Val)) {
+    LLVMMetadataRef Loc = LLVMInstructionGetDebugLoc(Val);
+    if (Loc) {
+      LLVMMetadataRef Scope = LLVMDILocationGetScope(Loc);
+      if (Scope) {
+        F = LLVMDIScopeGetFile(Scope);
+      }
+    }
+  } else if (LLVMIsAGlobalVariable(Val)) {
+    LLVMMetadataRef Var = global_variable_get_divariable(Val);
+    if (Var) {
+      F = LLVMDIVariableGetFile(Var);
+    }
+  } else if (LLVMIsAFunction(Val)) {
+    LLVMMetadataRef Subprogram = LLVMGetSubprogram(Val);
+    if (Subprogram) {
+      F = LLVMDIScopeGetFile(Subprogram);
+    }
+  }
+  return F;
+}
+
+/* llvalue -> string option */
+CAMLprim value llvm_get_debug_loc_directory(LLVMValueRef Val) {
+  CAMLparam0();
+  CAMLlocal1(Option);
+  unsigned Length = 0;
+  const char *Chars;
+  LLVMMetadataRef File = get_debug_file(Val);
+  if (File) {
+    Chars = LLVMDIFileGetDirectory(File, &Length);
+  };
+  Option = cstr_to_string_option(Chars, Length);
+  CAMLreturn(Option);
+}
+
+/* llvalue -> string option */
+CAMLprim value llvm_get_debug_loc_filename(LLVMValueRef Val) {
+  CAMLparam0();
+  CAMLlocal1(Option);
+  unsigned Length = 0;
+  const char *Chars;
+  LLVMMetadataRef File = get_debug_file(Val);
+  if (File) {
+    Chars = LLVMDIFileGetFilename(File, &Length);
+  };
+  Option = cstr_to_string_option(Chars, Length);
+  CAMLreturn(Option);
+}
+
+/* llvalue -> int */
+CAMLprim value llvm_get_debug_loc_line(LLVMValueRef Val) {
+  unsigned L = 0;
+  if (LLVMIsAInstruction(Val)) {
+    LLVMMetadataRef Loc = LLVMInstructionGetDebugLoc(Val);
+    if (Loc) {
+      L = LLVMDILocationGetLine(Loc);
+    }
+  } else if (LLVMIsAGlobalVariable(Val)) {
+    LLVMMetadataRef Var = global_variable_get_divariable(Val);
+    if (Var) {
+      L = LLVMDIVariableGetLine(Var);
+    }
+  } else if (LLVMIsAFunction(Val)) {
+    LLVMMetadataRef Subprogram = LLVMGetSubprogram(Val);
+    if (Subprogram) {
+      L = LLVMDISubprogramGetLine(Subprogram);
+    }
+  }
+  return Val_int(L);
+}
+
+/* llvalue -> int */
+CAMLprim value llvm_get_debug_loc_column(LLVMValueRef Val) {
+  unsigned C = 0;
+  if (LLVMIsAInstruction(Val)) {
+    LLVMMetadataRef Loc = LLVMInstructionGetDebugLoc(Val);
+    if (Loc) {
+      C = LLVMDILocationGetColumn(Loc);
+    }
+  }
+  return Val_int(C);
+}
+
 /*--... Operations on scalar constants .....................................--*/
 
 /* lltype -> int -> llvalue */
 CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) {
   return LLVMConstInt(IntTy, (long long) Long_val(N), 1);
 }
 
 /* lltype -> Int64.t -> bool -> llvalue */