[OCaml] Add OCaml APIs to access DebugInfo

[jberdine]

Summary

This diff adds a debuginfo sublibrary to the ocaml bindings
library. This is used to expose the DebugInfo API, mostly as declared
in include/llvm-c/DebugInfo.h. Currently this is incomplete: only
containing the functions needed to obtain the debug location
directory, filename, line, and column of instructions, global
variables, and functions.

[jberdine]

This is an alternative to D52239 which adds OCaml wrappers of the C API that are as thin as I see how to make them. I added a new sublibrary since the exposed functions come from DebugInfo.h instead of Core.h, and that seemed to be the pattern for the other sublibraries. Does this seem like the right approach?

[jberdine]

To test this I have an OCaml client (a slightly modified version of https://github.com/facebook/infer/blob/master/sledge/src/llair/frontend.ml) that reads and prints the debug info using the functions in llvm_debuginfo.mli for all of the .bc and .ll files under the test directory, as well as a number of larger internal compilation units.

[jberdine]

@whitequark, with this diff's approach of creating a hierarchy of types to mirror the LLVM-C DI types, is it acceptable to add the types and functions incrementally? That is, could we land this diff and add other types and functions later?

Another question is about opam. Since this diff adds a sub-library, the opam package files will need to change. Is there any experience / best practice about how to handle this? In particular, since the opam package files are not in the llvm repo, it will not be easily possible to pin the llvm dev repo.

[whitequark]

@whitequark, with this diff's approach of creating a hierarchy of types to mirror the LLVM-C DI types, is it acceptable to add the types and functions incrementally? That is, could we land this diff and add other types and functions later?

Yes, that would be perfectly fine, and is in line with the extension of LLVM-C in the past.

Another question is about opam. Since this diff adds a sub-library, the opam package files will need to change. Is there any experience / best practice about how to handle this? In particular, since the opam package files are not in the llvm repo, it will not be easily possible to pin the llvm dev repo.

I'm afraid there's no existing procedure for this. If the opam file does not have to be in the root of the repo (I forget exactly how it works), we could add it here.

[jberdine]

I will experiment with putting the opam file below the repo root. Another potential stumbling point is that the opam package includes some patches for the build/install, see https://github.com/ocaml/opam-repository/tree/master/packages/llvm/llvm.9.0.0/files . Would it be too strange to include such patches here?

[whitequark]

Would it be too strange to include such patches here?

Yes. The patches should either be removed or investigated and applied in tree.

[jberdine]

This is superceded by https://reviews.llvm.org/D90831

bindings/ocaml/CMakeLists.txt

 add_subdirectory(llvm)
 add_subdirectory(all_backends)
 add_subdirectory(analysis)
 add_subdirectory(backends)
 add_subdirectory(bitreader)
 add_subdirectory(bitwriter)
 add_subdirectory(irreader)
 add_subdirectory(linker)
 add_subdirectory(target)
 add_subdirectory(transforms)
 add_subdirectory(executionengine)
+add_subdirectory(debuginfo)

bindings/ocaml/debuginfo/CMakeLists.txt

+add_ocaml_library(llvm_debuginfo
+  OCAML    llvm_debuginfo
+  OCAMLDEP llvm
+  C        debuginfo_ocaml
+  LLVM     debuginfo)

bindings/ocaml/debuginfo/debuginfo_ocaml.c

+/*===-- debuginfo_ocaml.c - LLVM OCaml Glue ---------------------*- C++ -*-===*\
+|*                                                                            *|
+|* Part of the LLVM Project, under the Apache License v2.0 with LLVM          *|
+|* Exceptions.                                                                *|
+|* See https://llvm.org/LICENSE.txt for license information.                  *|
+|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception                    *|
+|*                                                                            *|
+|*===----------------------------------------------------------------------===*|
+|*                                                                            *|
+|* This file glues LLVM's OCaml interface to its C interface. These functions *|
+|* are by and large transparent wrappers to the corresponding C functions.    *|
+|*                                                                            *|
+|* Note that these functions intentionally take liberties with the CAMLparamX *|
+|* macros, since most of the parameters are not GC heap objects.              *|
+|*                                                                            *|
+\*===----------------------------------------------------------------------===*/
+
+#include "caml/alloc.h"
+#include "caml/memory.h"
+#include "llvm-c/DebugInfo.h"
+#include <string.h>
+
+/* Convert a C pointer to an OCaml option */
+CAMLprim value ptr_to_option(void *Ptr) {
+  CAMLparam0();
+  CAMLlocal1(Option);
+  if (!Ptr)
+    CAMLreturn(Val_int(0));
+  Option = caml_alloc_small(1, 0);
+  Store_field(Option, 0, (value)Ptr);
+  CAMLreturn(Option);
+}
+
+/* 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)
+    CAMLreturn(Val_int(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);
+}
+
+/* llvalue -> lldilocation option */
+CAMLprim value llvm_instr_get_debug_loc(LLVMValueRef Instr) {
+  return ptr_to_option(LLVMInstructionGetDebugLoc(Instr));
+}
+
+/* lldilocation -> int */
+CAMLprim value llvm_dilocation_get_column(LLVMMetadataRef Loc) {
+  return Val_int(LLVMDILocationGetColumn(Loc));
+}
+
+/* lldilocation -> int */
+CAMLprim value llvm_dilocation_get_line(LLVMMetadataRef Loc) {
+  return Val_int(LLVMDILocationGetLine(Loc));
+}
+
+/* lldilocation -> lldiscope option */
+CAMLprim value llvm_dilocation_get_scope(LLVMMetadataRef Loc) {
+  return ptr_to_option(LLVMDILocationGetScope(Loc));
+}
+
+/* llvalue -> lldisubprogram option */
+CAMLprim value llvm_get_subprogram(LLVMValueRef Func) {
+  return ptr_to_option(LLVMGetSubprogram(Func));
+}
+
+/* lldisubprogram -> int */
+CAMLprim value llvm_disubprogram_get_line(LLVMMetadataRef Subprogram) {
+  return Val_int(LLVMDISubprogramGetLine(Subprogram));
+}
+
+/* lldiscope -> lldifile option */
+CAMLprim value llvm_discope_get_file(LLVMMetadataRef Scope) {
+  return ptr_to_option(LLVMDIScopeGetFile(Scope));
+}
+
+/* lldifile -> string option */
+CAMLprim value llvm_difile_get_directory(LLVMMetadataRef File) {
+  unsigned Length = 0;
+  return (cstr_to_string_option(LLVMDIFileGetDirectory(File, &Length), Length));
+}
+
+/* lldifile -> string option */
+CAMLprim value llvm_difile_get_filename(LLVMMetadataRef File) {
+  unsigned Length = 0;
+  return (cstr_to_string_option(LLVMDIFileGetFilename(File, &Length), Length));
+}
+
+/* llmetadata -> lldivariable option */
+CAMLprim value
+llvm_diglobalvariableexpression_get_divariable(LLVMMetadataRef GVE) {
+  return (ptr_to_option(LLVMDIGlobalVariableExpressionGetVariable(GVE)));
+}
+
+/* lldivariable -> int */
+CAMLprim value llvm_divariable_get_line(LLVMMetadataRef Variable) {
+  return Val_int(LLVMDIVariableGetLine(Variable));
+}
+
+/* lldivariable -> lldifile option */
+CAMLprim value llvm_divariable_get_file(LLVMMetadataRef Variable) {
+  return ptr_to_option(LLVMDIVariableGetFile(Variable));
+}

bindings/ocaml/debuginfo/llvm_debuginfo.ml

+(*===-- llvm_debuginfo.ml - LLVM OCaml Interface --------------*- OCaml -*-===*
+ *
+ * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+ * See https://llvm.org/LICENSE.txt for license information.
+ * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+ *
+ *===----------------------------------------------------------------------===*)
+
+external instr_get_debug_loc : Llvm.llvalue -> Llvm.llmetadata option
+  = "llvm_instr_get_debug_loc"
+
+external dilocation_get_column : Llvm.llmetadata -> int
+  = "llvm_dilocation_get_column"
+
+external dilocation_get_line : Llvm.llmetadata -> int
+  = "llvm_dilocation_get_line"
+
+external dilocation_get_scope : Llvm.llmetadata -> Llvm.llmetadata option
+  = "llvm_dilocation_get_scope"
+
+external get_subprogram : Llvm.llvalue -> Llvm.llmetadata option
+  = "llvm_get_subprogram"
+
+external disubprogram_get_line : Llvm.llmetadata -> int
+  = "llvm_disubprogram_get_line"
+
+external discope_get_file : Llvm.llmetadata -> Llvm.llmetadata option
+  = "llvm_discope_get_file"
+
+external difile_get_directory : Llvm.llmetadata -> string option
+  = "llvm_difile_get_directory"
+
+external difile_get_filename : Llvm.llmetadata -> string option
+  = "llvm_difile_get_filename"
+
+external diglobalvariableexpression_get_divariable
+  : Llvm.llmetadata -> Llvm.llmetadata option
+  = "llvm_diglobalvariableexpression_get_divariable"
+
+external divariable_get_line : Llvm.llmetadata -> int
+  = "llvm_divariable_get_line"
+
+external divariable_get_file : Llvm.llmetadata -> Llvm.llmetadata option
+  = "llvm_divariable_get_file"

bindings/ocaml/debuginfo/llvm_debuginfo.mli

+(*===-- llvm_debuginfo.mli - LLVM OCaml Interface -------------*- OCaml -*-===*
+ *
+ * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+ * See https://llvm.org/LICENSE.txt for license information.
+ * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+ *
+ *===----------------------------------------------------------------------===*)
+
+(** [instr_get_debug_loc v] returns the debug location for [v], which must be
+    an [Instruction].
+    See the [llvm::Instruction::getDebugLoc()] method. *)
+external instr_get_debug_loc : Llvm.llvalue -> Llvm.llmetadata option
+  = "llvm_instr_get_debug_loc"
+
+(** [dilocation_get_column l] returns the column number of the debug location
+    [l].
+    See the [llvm::DILocation::getColumn()] method. *)
+external dilocation_get_column : Llvm.llmetadata -> int
+  = "llvm_dilocation_get_column"
+
+(** [dilocation_get_line l] returns the line number of the debug location
+    [l].
+    See the [llvm::DILocation::getLine()] method. *)
+external dilocation_get_line : Llvm.llmetadata -> int
+  = "llvm_dilocation_get_line"
+
+(** [dilocation_get_scope l] returns the scope of the debug location [l].
+    See the [llvm::DILocation::getScope()] method. *)
+external dilocation_get_scope : Llvm.llmetadata -> Llvm.llmetadata option
+  = "llvm_dilocation_get_scope"
+
+(** [get_subprogram v] returns the subprogram of [v], which must be a
+    [Function].
+    See the [llvm::Function::getSubprogram()] method. *)
+external get_subprogram : Llvm.llvalue -> Llvm.llmetadata option
+  = "llvm_get_subprogram"
+
+(** [disubprogram_get_line s] returns the line number of the subprogram [s].
+    See the [llvm::DISubprogram::getLine()] method. *)
+external disubprogram_get_line : Llvm.llmetadata -> int
+  = "llvm_disubprogram_get_line"
+
+(** [discope_get_file s] returns the file of the scope [s].
+    See the [llvm::DIScope::getFile()] method. *)
+external discope_get_file : Llvm.llmetadata -> Llvm.llmetadata option
+  = "llvm_discope_get_file"
+
+(** [difile_get_directory f] returns the directory of the file [f].
+    See the [llvm::DIFile::getDirectory()] method. *)
+external difile_get_directory : Llvm.llmetadata -> string option
+  = "llvm_difile_get_directory"
+
+(** [difile_get_filename f] returns the filename of the file [f].
+    See the [llvm::DIFile::getFilename()] method. *)
+external difile_get_filename : Llvm.llmetadata -> string option
+  = "llvm_difile_get_filename"
+
+(** [diglobalvariableexpression_get_divariable gve] returns the debug variable
+    of [gve], which must be a [DIGlobalVariableExpression].
+    See the [llvm::DIGlobalVariableExpression::getVariable()] method. *)
+external diglobalvariableexpression_get_divariable
+  : Llvm.llmetadata -> Llvm.llmetadata option
+  = "llvm_diglobalvariableexpression_get_divariable"
+
+(** [divariable_get_line v] returns the line number of the variable [v].
+    See the [llvm::DIVariable::getLine()] method. *)
+external divariable_get_line : Llvm.llmetadata -> int
+  = "llvm_divariable_get_line"
+
+(** [divariable_get_file v] returns the file of the variable [v].
+    See the [llvm::DIVariable::getFile()] method. *)
+external divariable_get_file : Llvm.llmetadata -> Llvm.llmetadata option
+  = "llvm_divariable_get_file"

bindings/ocaml/llvm/META.llvm.in

 package "bitwriter" (
     requires = "llvm,unix"
     version = "@PACKAGE_VERSION@"
     description = "Bitcode writer for LLVM"
     archive(byte) = "llvm_bitwriter.cma"
     archive(native) = "llvm_bitwriter.cmxa"
 )
 
+package "debuginfo" (
+    requires = "llvm"
+    version = "@PACKAGE_VERSION@"
+    description = "Debug information in LLVM IR form"
+    archive(byte) = "llvm_debuginfo.cma"
+    archive(native) = "llvm_debuginfo.cmxa"
+)
+
 package "executionengine" (
     requires = "llvm,llvm.target,ctypes.foreign"
     version = "@PACKAGE_VERSION@"
     description = "JIT and Interpreter for LLVM"
     archive(byte) = "llvm_executionengine.cma"
     archive(native) = "llvm_executionengine.cmxa"
 )
 

bindings/ocaml/llvm/llvm.ml

 type llvalue
 type lluse
 type llbasicblock
 type llbuilder
 type llattrkind
 type llattribute
 type llmemorybuffer
 type llmdkind
+type llmetadata
 
 exception FeatureDisabled of string
 
 let () = Callback.register_exception "Llvm.FeatureDisabled" (FeatureDisabled "")
 
 module TypeKind = struct
   type t =
   | Void

 external section : llvalue -> string = "llvm_section"
 external set_section : string -> llvalue -> unit = "llvm_set_section"
 external visibility : llvalue -> Visibility.t = "llvm_visibility"
 external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility"
 external dll_storage_class : llvalue -> DLLStorageClass.t = "llvm_dll_storage_class"
 external set_dll_storage_class : DLLStorageClass.t -> llvalue -> unit = "llvm_set_dll_storage_class"
 external alignment : llvalue -> int = "llvm_alignment"
 external set_alignment : int -> llvalue -> unit = "llvm_set_alignment"
+external global_copy_all_metadata : llvalue -> (llmdkind * llmetadata) array
+                                  = "llvm_global_copy_all_metadata"
 external is_global_constant : llvalue -> bool = "llvm_is_global_constant"
 external set_global_constant : bool -> llvalue -> unit
                              = "llvm_set_global_constant"
 
 (*--... Operations on global variables .....................................--*)
 external declare_global : lltype -> string -> llmodule -> llvalue
                         = "llvm_declare_global"
 external declare_qualified_global : lltype -> string -> int -> llmodule ->

bindings/ocaml/llvm/llvm.mli

 
 (** Used to efficiently handle large buffers of read-only binary data.
     See the [llvm::MemoryBuffer] class. *)
 type llmemorybuffer
 
 (** The kind id of metadata attached to an instruction. *)
 type llmdkind
 
+(** Metadata in the IR. See the [llvm::Metadata] class. *)
+type llmetadata
+
 (** The kind of an [lltype], the result of [classify_type ty]. See the
     [llvm::Type::TypeID] enumeration. *)
 module TypeKind : sig
   type t =
     Void
   | Half
   | Float
   | Double

 (** [alignment g] returns the required alignment of the global value [g].
     See the method [llvm::GlobalValue::getAlignment]. *)
 val alignment : llvalue -> int
 
 (** [set_alignment n g] sets the required alignment of the global value [g] to
     [n] bytes. See the method [llvm::GlobalValue::setAlignment]. *)
 val set_alignment : int -> llvalue -> unit
 
+(** [global_copy_all_metadata g] returns all the metadata associated with [g],
+    which must be an [Instruction] or [GlobalObject].
+    See the [llvm::Instruction::getAllMetadata()] and
+    [llvm::GlobalObject::getAllMetadata()] methods. *)
+val global_copy_all_metadata : llvalue -> (llmdkind * llmetadata) array
 
 (** {7 Operations on global variables} *)
 
 (** [declare_global ty name m] returns a new global variable of type [ty] and
     with name [name] in module [m] in the default address space (0). If such a
     global variable already exists, it is returned. If the type of the existing
     global differs, then a bitcast to [ty] is returned. *)
 val declare_global : lltype -> string -> llmodule -> llvalue

bindings/ocaml/llvm/llvm_ocaml.c

 }
 
 /* int -> llvalue -> unit */
 CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
   LLVMSetAlignment(Global, Int_val(Bytes));
   return Val_unit;
 }
 
+/* llvalue -> (llmdkind * llmetadata) array */
+CAMLprim value llvm_global_copy_all_metadata(LLVMValueRef Global) {
+  CAMLparam0();
+  CAMLlocal2(Array, Pair);
+  size_t NumEntries;
+  LLVMValueMetadataEntry *Entries =
+      LLVMGlobalCopyAllMetadata(Global, &NumEntries);
+  Array = caml_alloc_tuple(NumEntries);
+  for (int i = 0; i < NumEntries; i++) {
+    Pair = caml_alloc_tuple(2);
+    Store_field(Pair, 0, Val_int(LLVMValueMetadataEntriesGetKind(Entries, i)));
+    Store_field(Pair, 1,
+                (value)LLVMValueMetadataEntriesGetMetadata(Entries, i));
+    Store_field(Array, i, Pair);
+  }
+  LLVMDisposeValueMetadataEntries(Entries);
+  CAMLreturn(Array);
+}
+
 /*--... Operations on uses .................................................--*/
 
 /* llvalue -> lluse option */
 CAMLprim value llvm_use_begin(LLVMValueRef Val) {
   CAMLparam0();
   LLVMUseRef First;
   if ((First = LLVMGetFirstUse(Val))) {
     value Option = alloc(1, 0);