Index: bindings/ocaml/llvm/llvm.ml =================================================================== --- bindings/ocaml/llvm/llvm.ml +++ bindings/ocaml/llvm/llvm.ml @@ -568,6 +568,10 @@ = "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" Index: bindings/ocaml/llvm/llvm.mli =================================================================== --- bindings/ocaml/llvm/llvm.mli +++ bindings/ocaml/llvm/llvm.mli @@ -910,6 +910,32 @@ [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} *) Index: bindings/ocaml/llvm/llvm_ocaml.c =================================================================== --- bindings/ocaml/llvm/llvm_ocaml.c +++ bindings/ocaml/llvm/llvm_ocaml.c @@ -19,6 +19,7 @@ #include #include #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 @@ 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 */