[sledge][llvm] Add OCaml APIs to access DebugLoc info

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

Reviewed By: jvillard

Differential Revision: D27188296

fbshipit-source-id: 52129f957

sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm.ml

@@ -568,6 +568,10 @@ 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"

sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm.mli

@@ -910,6 +910,32 @@ val get_named_metadata : llmodule -> string -> llvalue array
     [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} *)
 

sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm_ocaml.c

@@ -19,6 +19,7 @@
 #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"
@@ -863,6 +864,126 @@ CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef 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 */