Index: llvm/bindings/ocaml/CMakeLists.txt =================================================================== --- llvm/bindings/ocaml/CMakeLists.txt +++ llvm/bindings/ocaml/CMakeLists.txt @@ -4,6 +4,7 @@ add_subdirectory(backends) add_subdirectory(bitreader) add_subdirectory(bitwriter) +add_subdirectory(debuginfo) add_subdirectory(irreader) add_subdirectory(linker) add_subdirectory(target) Index: llvm/bindings/ocaml/README.txt =================================================================== --- llvm/bindings/ocaml/README.txt +++ llvm/bindings/ocaml/README.txt @@ -20,7 +20,8 @@ LLVM. To do this, configure the LLVM build tree as follows: $ cmake -DLLVM_OCAML_OUT_OF_TREE=TRUE \ - -DCMAKE_INSTALL_PREFIX=[OCaml install prefix] \ + -DCMAKE_INSTALL_PREFIX=[Preinstalled LLVM path] \ + -DLLVM_OCAML_INSTALL_PATH=[OCaml install prefix] \ [... any other options] then build and install it as: Index: llvm/bindings/ocaml/debuginfo/CMakeLists.txt =================================================================== --- /dev/null +++ llvm/bindings/ocaml/debuginfo/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_debuginfo + OCAML llvm_debuginfo + OCAMLDEP llvm + C debuginfo_ocaml + LLVM DebugInfoDwarf) Index: llvm/bindings/ocaml/debuginfo/debuginfo_ocaml.c =================================================================== --- /dev/null +++ llvm/bindings/ocaml/debuginfo/debuginfo_ocaml.c @@ -0,0 +1,916 @@ +/*===-- 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 + +#include "caml/alloc.h" +#include "caml/custom.h" +#include "caml/memory.h" +#include "caml/mlvalues.h" +#include "llvm-c/Core.h" +#include "llvm-c/DebugInfo.h" +#include "llvm-c/Support.h" + +// This is identical to the definition in llvm_debuginfo.ml:DIFlag.t +typedef enum { + i_DIFlagZero, + i_DIFlagPrivate, + i_DIFlagProtected, + i_DIFlagPublic, + i_DIFlagFwdDecl, + i_DIFlagAppleBlock, + i_DIFlagReservedBit4, + i_DIFlagVirtual, + i_DIFlagArtificial, + i_DIFlagExplicit, + i_DIFlagPrototyped, + i_DIFlagObjcClassComplete, + i_DIFlagObjectPointer, + i_DIFlagVector, + i_DIFlagStaticMember, + i_DIFlagLValueReference, + i_DIFlagRValueReference, + i_DIFlagReserved, + i_DIFlagSingleInheritance, + i_DIFlagMultipleInheritance, + i_DIFlagVirtualInheritance, + i_DIFlagIntroducedVirtual, + i_DIFlagBitField, + i_DIFlagNoReturn, + i_DIFlagTypePassByValue, + i_DIFlagTypePassByReference, + i_DIFlagEnumClass, + i_DIFlagFixedEnum, + i_DIFlagThunk, + i_DIFlagNonTrivial, + i_DIFlagBigEndian, + i_DIFlagLittleEndian, + i_DIFlagIndirectVirtualBase, + i_DIFlagAccessibility, + i_DIFlagPtrToMemberRep +} LLVMDIFlag_i; + +static LLVMDIFlags map_DIFlag(LLVMDIFlag_i DIF) { + switch (DIF) { + case i_DIFlagZero: + return LLVMDIFlagZero; + case i_DIFlagPrivate: + return LLVMDIFlagPrivate; + case i_DIFlagProtected: + return LLVMDIFlagProtected; + case i_DIFlagPublic: + return LLVMDIFlagPublic; + case i_DIFlagFwdDecl: + return LLVMDIFlagFwdDecl; + case i_DIFlagAppleBlock: + return LLVMDIFlagAppleBlock; + case i_DIFlagReservedBit4: + return LLVMDIFlagReservedBit4; + case i_DIFlagVirtual: + return LLVMDIFlagVirtual; + case i_DIFlagArtificial: + return LLVMDIFlagArtificial; + case i_DIFlagExplicit: + return LLVMDIFlagExplicit; + case i_DIFlagPrototyped: + return LLVMDIFlagPrototyped; + case i_DIFlagObjcClassComplete: + return LLVMDIFlagObjcClassComplete; + case i_DIFlagObjectPointer: + return LLVMDIFlagObjectPointer; + case i_DIFlagVector: + return LLVMDIFlagVector; + case i_DIFlagStaticMember: + return LLVMDIFlagStaticMember; + case i_DIFlagLValueReference: + return LLVMDIFlagLValueReference; + case i_DIFlagRValueReference: + return LLVMDIFlagRValueReference; + case i_DIFlagReserved: + return LLVMDIFlagReserved; + case i_DIFlagSingleInheritance: + return LLVMDIFlagSingleInheritance; + case i_DIFlagMultipleInheritance: + return LLVMDIFlagMultipleInheritance; + case i_DIFlagVirtualInheritance: + return LLVMDIFlagVirtualInheritance; + case i_DIFlagIntroducedVirtual: + return LLVMDIFlagIntroducedVirtual; + case i_DIFlagBitField: + return LLVMDIFlagBitField; + case i_DIFlagNoReturn: + return LLVMDIFlagNoReturn; + case i_DIFlagTypePassByValue: + return LLVMDIFlagTypePassByValue; + case i_DIFlagTypePassByReference: + return LLVMDIFlagTypePassByReference; + case i_DIFlagEnumClass: + return LLVMDIFlagEnumClass; + case i_DIFlagFixedEnum: + return LLVMDIFlagFixedEnum; + case i_DIFlagThunk: + return LLVMDIFlagThunk; + case i_DIFlagNonTrivial: + return LLVMDIFlagNonTrivial; + case i_DIFlagBigEndian: + return LLVMDIFlagBigEndian; + case i_DIFlagLittleEndian: + return LLVMDIFlagLittleEndian; + case i_DIFlagIndirectVirtualBase: + return LLVMDIFlagIndirectVirtualBase; + case i_DIFlagAccessibility: + return LLVMDIFlagAccessibility; + case i_DIFlagPtrToMemberRep: + return LLVMDIFlagPtrToMemberRep; + } +} + +/* 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); +} + +CAMLprim value llvm_debug_metadata_version(value Unit) { + return Val_int(LLVMDebugMetadataVersion()); +} + +CAMLprim value llvm_get_module_debug_metadata_version(LLVMModuleRef Module) { + return Val_int(LLVMGetModuleDebugMetadataVersion(Module)); +} + +#define DIFlags_val(v) (*(LLVMDIFlags *)(Data_custom_val(v))) + +static struct custom_operations diflags_ops = { + (char *)"DebugInfo.lldiflags", custom_finalize_default, + custom_compare_default, custom_hash_default, + custom_serialize_default, custom_deserialize_default, + custom_compare_ext_default}; + +static value alloc_diflags(LLVMDIFlags Flags) { + value V = alloc_custom(&diflags_ops, sizeof(LLVMDIFlags), 0, 1); + DIFlags_val(V) = Flags; + return V; +} + +CAMLprim LLVMDIFlags llvm_diflags_get(value i_Flag) { + LLVMDIFlags Flags = 0; + Flags |= map_DIFlag(Int_val(i_Flag)); + return alloc_diflags(Flags); +} + +CAMLprim LLVMDIFlags llvm_diflags_set(value Flags, value i_Flag) { + LLVMDIFlags FlagsNew = DIFlags_val(Flags) | map_DIFlag(Int_val(i_Flag)); + return alloc_diflags(FlagsNew); +} + +CAMLprim value llvm_diflags_test(value Flags, value i_Flag) { + LLVMDIFlags Flag = map_DIFlag(Int_val(i_Flag)); + return Val_bool((DIFlags_val(Flags) & Flag) == Flag); +} + +#define DIBuilder_val(v) (*(LLVMDIBuilderRef *)(Data_custom_val(v))) + +static void llvm_finalize_dibuilder(value B) { + LLVMDIBuilderFinalize(DIBuilder_val(B)); + LLVMDisposeDIBuilder(DIBuilder_val(B)); +} + +static struct custom_operations dibuilder_ops = { + (char *)"DebugInfo.lldibuilder", llvm_finalize_dibuilder, + custom_compare_default, custom_hash_default, + custom_serialize_default, custom_deserialize_default, + custom_compare_ext_default}; + +static value alloc_dibuilder(LLVMDIBuilderRef B) { + value V = alloc_custom(&dibuilder_ops, sizeof(LLVMDIBuilderRef), 0, 1); + DIBuilder_val(V) = B; + return V; +} + +/* llmodule -> lldibuilder */ +CAMLprim value llvm_dibuilder(LLVMModuleRef M) { + return alloc_dibuilder(LLVMCreateDIBuilder(M)); +} + +CAMLprim value llvm_dibuild_finalize(value Builder) { + LLVMDIBuilderFinalize(DIBuilder_val(Builder)); + return Val_unit; +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_compile_unit_native( + value Builder, value Lang, LLVMMetadataRef FileRef, value Producer, + value IsOptimized, value Flags, value RuntimeVer, value SplitName, + value Kind, value DWOId, value SplitDebugInline, + value DebugInfoForProfiling, value SysRoot, value SDK) { + return LLVMDIBuilderCreateCompileUnit( + DIBuilder_val(Builder), Int_val(Lang), FileRef, String_val(Producer), + caml_string_length(Producer), Bool_val(IsOptimized), String_val(Flags), + caml_string_length(Flags), Int_val(RuntimeVer), String_val(SplitName), + caml_string_length(SplitName), Int_val(Kind), Int_val(DWOId), + Bool_val(SplitDebugInline), Bool_val(DebugInfoForProfiling), + String_val(SysRoot), caml_string_length(SysRoot), String_val(SDK), + caml_string_length(SDK)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_compile_unit_bytecode(value *argv, + int argn) { + return llvm_dibuild_create_compile_unit_native( + argv[0], // Builder + argv[1], // Lang + (LLVMMetadataRef)argv[2], // FileRef + argv[3], // Producer + argv[4], // IsOptimized + argv[5], // Flags + argv[6], // RuntimeVer + argv[7], // SplitName + argv[8], // Kind + argv[9], // DWOId + argv[10], // SplitDebugInline + argv[11], // DebugInfoForProfiling + argv[12], // SysRoot + argv[13] // SDK + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_file(value Builder, value Filename, + value Directory) { + return LLVMDIBuilderCreateFile(DIBuilder_val(Builder), String_val(Filename), + caml_string_length(Filename), + String_val(Directory), + caml_string_length(Directory)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_module_native( + value Builder, LLVMMetadataRef ParentScope, value Name, value ConfigMacros, + value IncludePath, value SysRoot) { + return LLVMDIBuilderCreateModule( + DIBuilder_val(Builder), ParentScope, String_val(Name), + caml_string_length(Name), String_val(ConfigMacros), + caml_string_length(ConfigMacros), String_val(IncludePath), + caml_string_length(IncludePath), String_val(SysRoot), + caml_string_length(SysRoot)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_module_bytecode(value *argv, + int argn) { + return llvm_dibuild_create_module_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // ParentScope + argv[2], // Name + argv[3], // ConfigMacros + argv[4], // IncludePath + argv[5] // SysRoot + ); +} + +CAMLprim LLVMMetadataRef +llvm_dibuild_create_namespace(value Builder, LLVMMetadataRef ParentScope, + value Name, value ExportSymbols) { + return LLVMDIBuilderCreateNameSpace( + DIBuilder_val(Builder), ParentScope, String_val(Name), + caml_string_length(Name), Bool_val(ExportSymbols)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_function_native( + value Builder, LLVMMetadataRef Scope, value Name, value LinkageName, + LLVMMetadataRef File, value LineNo, LLVMMetadataRef Ty, value IsLocalToUnit, + value IsDefinition, value ScopeLine, value Flags, value IsOptimized) { + return LLVMDIBuilderCreateFunction( + DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name), + String_val(LinkageName), caml_string_length(LinkageName), File, + Int_val(LineNo), Ty, Bool_val(IsLocalToUnit), Bool_val(IsDefinition), + Int_val(ScopeLine), DIFlags_val(Flags), Bool_val(IsOptimized)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_function_bytecode(value *argv, + int argn) { + return llvm_dibuild_create_function_native(argv[0], // Builder, + (LLVMMetadataRef)argv[1], // Scope + argv[2], // Name + argv[3], // LinkageName + (LLVMMetadataRef)argv[4], // File + argv[5], // LineNo + (LLVMMetadataRef)argv[6], // Ty + argv[7], // IsLocalUnit + argv[8], // IsDefinition + argv[9], // ScopeLine + argv[10], // Flags + argv[11] // IsOptimized + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_lexical_block( + value Builder, LLVMMetadataRef Scope, LLVMMetadataRef File, value Line, + value Column) { + return LLVMDIBuilderCreateLexicalBlock(DIBuilder_val(Builder), Scope, File, + Int_val(Line), Int_val(Column)); +} + +CAMLprim LLVMMetadataRef llvm_metadata_null() { return (LLVMMetadataRef)NULL; } + +CAMLprim LLVMMetadataRef llvm_dibuild_create_debug_location( + LLVMContextRef Ctx, value Line, value Column, LLVMMetadataRef Scope, + LLVMMetadataRef InlinedAt) { + return LLVMDIBuilderCreateDebugLocation(Ctx, Int_val(Line), Int_val(Column), + Scope, InlinedAt); +} + +CAMLprim value llvm_di_location_get_line(LLVMMetadataRef Location) { + return Val_int(LLVMDILocationGetLine(Location)); +} + +CAMLprim value llvm_di_location_get_column(LLVMMetadataRef Location) { + return Val_int(LLVMDILocationGetColumn(Location)); +} + +CAMLprim LLVMMetadataRef llvm_di_location_get_scope(LLVMMetadataRef Location) { + return LLVMDILocationGetScope(Location); +} + +CAMLprim LLVMMetadataRef +llvm_di_location_get_inlined_at(LLVMMetadataRef Location) { + return LLVMDILocationGetInlinedAt(Location); +} + +CAMLprim value llvm_di_scope_get_file(LLVMMetadataRef Scope) { + return (ptr_to_option(LLVMDIScopeGetFile(Scope))); +} + +CAMLprim value llvm_di_file_get_directory(LLVMMetadataRef File) { + unsigned Len; + const char *Directory = LLVMDIFileGetDirectory(File, &Len); + value String; + if (Directory) { + String = caml_alloc_initialized_string(Len, Directory); + } else { + String = caml_alloc_string(0); + } + return String; +} + +CAMLprim value llvm_di_file_get_filename(LLVMMetadataRef File) { + unsigned Len; + const char *Filename = LLVMDIFileGetFilename(File, &Len); + value String; + if (Filename) { + String = caml_alloc_initialized_string(Len, Filename); + } else { + String = caml_alloc_string(0); + } + return String; +} + +CAMLprim value llvm_di_file_get_source(LLVMMetadataRef File) { + unsigned Len; + const char *Source = LLVMDIFileGetSource(File, &Len); + value String; + if (Source) { + String = caml_alloc_initialized_string(Len, Source); + } else { + String = caml_alloc_string(0); + } + return String; +} + +CAMLprim LLVMMetadataRef llvm_dibuild_get_or_create_type_array(value Builder, + value Data) { + + return LLVMDIBuilderGetOrCreateTypeArray(DIBuilder_val(Builder), + (LLVMMetadataRef *)Op_val(Data), + Wosize_val(Data)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_subroutine_type( + value Builder, LLVMMetadataRef File, value ParameterTypes, value Flags) { + + return LLVMDIBuilderCreateSubroutineType( + DIBuilder_val(Builder), File, (LLVMMetadataRef *)Op_val(ParameterTypes), + Wosize_val(ParameterTypes), DIFlags_val(Flags)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_enumerator(value Builder, + value Name, value Value, + value IsUnsigned) { + return LLVMDIBuilderCreateEnumerator( + DIBuilder_val(Builder), String_val(Name), caml_string_length(Name), + (int64_t)Int_val(Value), Bool_val(IsUnsigned)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_enumeration_type_native( + value Builder, LLVMMetadataRef Scope, value Name, LLVMMetadataRef File, + value LineNumber, value SizeInBits, value AlignInBits, value Elements, + LLVMMetadataRef ClassTy) { + return LLVMDIBuilderCreateEnumerationType( + DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name), + File, Int_val(LineNumber), (uint64_t)Int_val(SizeInBits), + Int_val(AlignInBits), (LLVMMetadataRef *)Op_val(Elements), + Wosize_val(Elements), ClassTy); +} + +CAMLprim LLVMMetadataRef +llvm_dibuild_create_enumeration_type_bytecode(value *argv, int argn) { + return llvm_dibuild_create_enumeration_type_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // Scope + argv[2], // Name + (LLVMMetadataRef)argv[3], // File + argv[4], // LineNumber + argv[5], // SizeInBits + argv[6], // AlignInBits + argv[7], // Elements + (LLVMMetadataRef)argv[8] // ClassTy + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_union_type_native( + value Builder, LLVMMetadataRef Scope, value Name, LLVMMetadataRef File, + value LineNumber, value SizeInBits, value AlignInBits, value Flags, + value Elements, value RunTimeLanguage, value UniqueId) { + + return LLVMDIBuilderCreateUnionType( + DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name), + File, Int_val(LineNumber), (uint64_t)Int_val(SizeInBits), + Int_val(AlignInBits), DIFlags_val(Flags), + (LLVMMetadataRef *)Op_val(Elements), Wosize_val(Elements), + Int_val(RunTimeLanguage), String_val(UniqueId), + caml_string_length(UniqueId)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_union_type_bytecode(value *argv, + int argn) { + return llvm_dibuild_create_union_type_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // Scope + argv[2], // Name + (LLVMMetadataRef)argv[3], // File + argv[4], // LineNumber + argv[5], // SizeInBits + argv[6], // AlignInBits + argv[7], // Flags + argv[8], // Elements + argv[9], // RunTimeLanguage + argv[10] // UniqueId + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_array_type(value Builder, + value Size, + value AlignInBits, + LLVMMetadataRef Ty, + value Subscripts) { + return LLVMDIBuilderCreateArrayType( + DIBuilder_val(Builder), (uint64_t)Int_val(Size), Int_val(AlignInBits), Ty, + (LLVMMetadataRef *)Op_val(Subscripts), Wosize_val(Subscripts)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_vector_type(value Builder, + value Size, + value AlignInBits, + LLVMMetadataRef Ty, + value Subscripts) { + return LLVMDIBuilderCreateVectorType( + DIBuilder_val(Builder), (uint64_t)Int_val(Size), Int_val(AlignInBits), Ty, + (LLVMMetadataRef *)Op_val(Subscripts), Wosize_val(Subscripts)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_unspecified_type(value Builder, + value Name) { + return LLVMDIBuilderCreateUnspecifiedType( + DIBuilder_val(Builder), String_val(Name), caml_string_length(Name)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_basic_type( + value Builder, value Name, value SizeInBits, value Encoding, value Flags) { + + return LLVMDIBuilderCreateBasicType( + DIBuilder_val(Builder), String_val(Name), caml_string_length(Name), + (uint64_t)Int_val(SizeInBits), Int_val(Encoding), DIFlags_val(Flags)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_pointer_type_native( + value Builder, LLVMMetadataRef PointeeTy, value SizeInBits, + value AlignInBits, value AddressSpace, value Name) { + return LLVMDIBuilderCreatePointerType( + DIBuilder_val(Builder), PointeeTy, (uint64_t)Int_val(SizeInBits), + Int_val(AlignInBits), Int_val(AddressSpace), String_val(Name), + caml_string_length(Name)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_pointer_type_bytecode(value *argv, + int argn) { + return llvm_dibuild_create_pointer_type_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // PointeeTy + argv[2], // SizeInBits + argv[3], // AlignInBits + argv[4], // AddressSpace + argv[5] // Name + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_struct_type_native( + value Builder, LLVMMetadataRef Scope, value Name, LLVMMetadataRef File, + value LineNumber, value SizeInBits, value AlignInBits, value Flags, + LLVMMetadataRef DerivedFrom, value Elements, value RunTimeLanguage, + LLVMMetadataRef VTableHolder, value UniqueId) { + + return LLVMDIBuilderCreateStructType( + DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name), + File, Int_val(LineNumber), (uint64_t)Int_val(SizeInBits), + Int_val(AlignInBits), DIFlags_val(Flags), DerivedFrom, + (LLVMMetadataRef *)Op_val(Elements), Wosize_val(Elements), + Int_val(RunTimeLanguage), VTableHolder, String_val(UniqueId), + caml_string_length(UniqueId)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_struct_type_bytecode(value *argv, + int argn) { + return llvm_dibuild_create_struct_type_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // Scope + argv[2], // Name + (LLVMMetadataRef)argv[3], // File + argv[4], // LineNumber + argv[5], // SizeInBits + argv[6], // AlignInBits + argv[7], // Flags + (LLVMMetadataRef)argv[8], // DeriviedFrom + argv[9], // Elements + argv[10], // RunTimeLanguage + (LLVMMetadataRef)argv[11], // VTableHolder + argv[12] // UniqueId + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_member_type_native( + value Builder, LLVMMetadataRef Scope, value Name, LLVMMetadataRef File, + value LineNumber, value SizeInBits, value AlignInBits, value OffsetInBits, + value Flags, LLVMMetadataRef Ty) { + + return LLVMDIBuilderCreateMemberType( + DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name), + File, Int_val(LineNumber), (uint64_t)Int_val(SizeInBits), + Int_val(AlignInBits), (uint64_t)Int_val(OffsetInBits), DIFlags_val(Flags), + Ty); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_member_type_bytecode(value *argv, + int argn) { + return llvm_dibuild_create_member_type_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // Scope + argv[2], // Name + (LLVMMetadataRef)argv[3], // File + argv[4], // LineNumber + argv[5], // SizeInBits + argv[6], // AlignInBits + argv[7], // OffsetInBits + argv[8], // Flags + (LLVMMetadataRef)argv[9] // Ty + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_static_member_type_native( + value Builder, LLVMMetadataRef Scope, value Name, LLVMMetadataRef File, + value LineNumber, LLVMMetadataRef Type, value Flags, + LLVMValueRef ConstantVal, value AlignInBits) { + + return LLVMDIBuilderCreateStaticMemberType( + DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name), + File, Int_val(LineNumber), Type, DIFlags_val(Flags), ConstantVal, + Int_val(AlignInBits)); +} + +CAMLprim LLVMMetadataRef +llvm_dibuild_create_static_member_type_bytecode(value *argv, int argn) { + return llvm_dibuild_create_static_member_type_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // Scope + argv[2], // Name + (LLVMMetadataRef)argv[3], // File + argv[4], // LineNumber + (LLVMMetadataRef)argv[5], // Type + argv[6], // Flags, + (LLVMValueRef)argv[7], // ConstantVal + argv[8] // AlignInBits + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_member_pointer_type_native( + value Builder, LLVMMetadataRef PointeeType, LLVMMetadataRef ClassType, + uint64_t SizeInBits, uint32_t AlignInBits, LLVMDIFlags Flags) { + + return LLVMDIBuilderCreateMemberPointerType( + DIBuilder_val(Builder), PointeeType, ClassType, + (uint64_t)Int_val(SizeInBits), Int_val(AlignInBits), Flags); +} + +CAMLprim LLVMMetadataRef +llvm_dibuild_create_member_pointer_type_bytecode(value *argv, int argn) { + return llvm_dibuild_create_member_pointer_type_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // PointeeType + (LLVMMetadataRef)argv[2], // ClassType + argv[3], // SizeInBits + argv[4], // AlignInBits + argv[5] // Flags + ); +} + +CAMLprim LLVMMetadataRef +llvm_dibuild_create_object_pointer_type(value Builder, LLVMMetadataRef Type) { + return LLVMDIBuilderCreateObjectPointerType(DIBuilder_val(Builder), Type); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_qualified_type( + value Builder, value Tag, LLVMMetadataRef Type) { + + return LLVMDIBuilderCreateQualifiedType(DIBuilder_val(Builder), Int_val(Tag), + Type); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_reference_type( + value Builder, value Tag, LLVMMetadataRef Type) { + + return LLVMDIBuilderCreateReferenceType(DIBuilder_val(Builder), Int_val(Tag), + Type); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_null_ptr_type(value Builder) { + + return LLVMDIBuilderCreateNullPtrType(DIBuilder_val(Builder)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_typedef_native( + value Builder, LLVMMetadataRef Type, value Name, LLVMMetadataRef File, + value LineNo, LLVMMetadataRef Scope, value AlignInBits) { + + return LLVMDIBuilderCreateTypedef( + DIBuilder_val(Builder), Type, String_val(Name), caml_string_length(Name), + File, Int_val(LineNo), Scope, Int_val(AlignInBits)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_typedef_bytecode(value *argv, + int argn) { + + return llvm_dibuild_create_typedef_native(argv[0], // Builder + (LLVMMetadataRef)argv[1], // Type + argv[2], // Name + (LLVMMetadataRef)argv[3], // File + argv[4], // LineNo + (LLVMMetadataRef)argv[5], // Scope + argv[6] // AlignInBits + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_inheritance_native( + value Builder, LLVMMetadataRef Ty, LLVMMetadataRef BaseTy, value BaseOffset, + value VBPtrOffset, value Flags) { + + return LLVMDIBuilderCreateInheritance(DIBuilder_val(Builder), Ty, BaseTy, + (uint64_t)Int_val(BaseOffset), + Int_val(VBPtrOffset), Flags); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_inheritance_bytecode(value *argv, + int arg) { + + return llvm_dibuild_create_inheritance_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // Ty + (LLVMMetadataRef)argv[2], // BaseTy + argv[3], // BaseOffset + argv[4], // VBPtrOffset + argv[5] // Flags + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_forward_decl_native( + value Builder, value Tag, value Name, LLVMMetadataRef Scope, + LLVMMetadataRef File, value Line, value RuntimeLang, value SizeInBits, + value AlignInBits, value UniqueIdentifier) { + return LLVMDIBuilderCreateForwardDecl( + DIBuilder_val(Builder), Int_val(Tag), String_val(Name), + caml_string_length(Name), Scope, File, Int_val(Line), + Int_val(RuntimeLang), (uint64_t)Int_val(SizeInBits), Int_val(AlignInBits), + String_val(UniqueIdentifier), caml_string_length(UniqueIdentifier)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_forward_decl_bytecode(value *argv, + int arg) { + + return llvm_dibuild_create_forward_decl_native( + argv[0], // Builder + argv[1], // Tag + argv[2], // Name + (LLVMMetadataRef)argv[3], // Scope + (LLVMMetadataRef)argv[4], // File + argv[5], // Line + argv[6], // RuntimeLang + argv[7], // SizeInBits + argv[8], // AlignInBits + argv[9] // UniqueIdentifier + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_replaceable_composite_type_native( + value Builder, value Tag, value Name, LLVMMetadataRef Scope, + LLVMMetadataRef File, value Line, value RuntimeLang, value SizeInBits, + value AlignInBits, value Flags, value UniqueIdentifier) { + + return LLVMDIBuilderCreateReplaceableCompositeType( + DIBuilder_val(Builder), Int_val(Tag), String_val(Name), + caml_string_length(Name), Scope, File, Int_val(Line), + Int_val(RuntimeLang), (uint64_t)Int_val(SizeInBits), Int_val(AlignInBits), + DIFlags_val(Flags), String_val(UniqueIdentifier), + caml_string_length(UniqueIdentifier)); +} + +CAMLprim LLVMMetadataRef +llvm_dibuild_create_replaceable_composite_type_bytecode(value *argv, int arg) { + + return llvm_dibuild_create_replaceable_composite_type_native( + argv[0], // Builder + argv[1], // Tag + argv[2], // Name + (LLVMMetadataRef)argv[3], // Scope + (LLVMMetadataRef)argv[4], // File + argv[5], // Line + argv[6], // RuntimeLang + argv[7], // SizeInBits + argv[8], // AlignInBits + argv[9], // Flags + argv[10] // UniqueIdentifier + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_bit_field_member_type_native( + value Builder, LLVMMetadataRef Scope, value Name, LLVMMetadataRef File, + value LineNum, value SizeInBits, value OffsetInBits, + value StorageOffsetInBits, value Flags, LLVMMetadataRef Ty) { + + return LLVMDIBuilderCreateBitFieldMemberType( + DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name), + File, Int_val(LineNum), (uint64_t)Int_val(SizeInBits), + (uint64_t)Int_val(OffsetInBits), (uint64_t)Int_val(StorageOffsetInBits), + DIFlags_val(Flags), Ty); +} + +CAMLprim LLVMMetadataRef +llvm_dibuild_create_bit_field_member_type_bytecode(value *argv, int arg) { + + return llvm_dibuild_create_bit_field_member_type_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // Scope + argv[2], // Name + (LLVMMetadataRef)argv[3], // File + argv[4], // LineNum + argv[5], // SizeInBits + argv[6], // OffsetInBits + argv[7], // StorageOffsetInBits + argv[8], // Flags + (LLVMMetadataRef)argv[9] // Ty + ); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_class_type_native( + value Builder, LLVMMetadataRef Scope, value Name, LLVMMetadataRef File, + value LineNumber, value SizeInBits, value AlignInBits, value OffsetInBits, + value Flags, LLVMMetadataRef DerivedFrom, value Elements, + LLVMMetadataRef VTableHolder, LLVMMetadataRef TemplateParamsNode, + value UniqueIdentifier) { + + return LLVMDIBuilderCreateClassType( + DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name), + File, Int_val(LineNumber), (uint64_t)Int_val(SizeInBits), + Int_val(AlignInBits), (uint64_t)Int_val(OffsetInBits), DIFlags_val(Flags), + DerivedFrom, (LLVMMetadataRef *)Op_val(Elements), Wosize_val(Elements), + VTableHolder, TemplateParamsNode, String_val(UniqueIdentifier), + caml_string_length(UniqueIdentifier)); +} + +CAMLprim LLVMMetadataRef llvm_dibuild_create_class_type_bytecode(value *argv, + int arg) { + + return llvm_dibuild_create_class_type_native( + argv[0], // Builder + (LLVMMetadataRef)argv[1], // Scope + argv[2], // Name + (LLVMMetadataRef)argv[3], // File + argv[4], // LineNumber + argv[5], // SizeInBits + argv[6], // AlignInBits + argv[7], // OffsetInBits + argv[8], // Flags + (LLVMMetadataRef)argv[9], // DerivedFrom + argv[10], // Elements + (LLVMMetadataRef)argv[11], // VTableHolder + (LLVMMetadataRef)argv[12], // TemplateParamsNode + argv[13] // UniqueIdentifier + ); +} + +CAMLprim LLVMMetadataRef +llvm_dibuild_create_artificial_type(value Builder, LLVMMetadataRef Type) { + return LLVMDIBuilderCreateArtificialType(DIBuilder_val(Builder), Type); +} + +CAMLprim value llvm_ditype_get_name(LLVMMetadataRef DType) { + size_t Len; + const char *Name = LLVMDITypeGetName(DType, &Len); + value String; + if (Name) { + String = caml_alloc_initialized_string(Len, Name); + } else { + String = caml_alloc_string(0); + } + return String; +} + +CAMLprim value llvm_ditype_get_size_in_bits(LLVMMetadataRef DType) { + uint64_t Size = LLVMDITypeGetSizeInBits(DType); + return Val_int((int)Size); +} + +CAMLprim value llvm_ditype_get_offset_in_bits(LLVMMetadataRef DType) { + uint64_t Size = LLVMDITypeGetOffsetInBits(DType); + return Val_int((int)Size); +} + +CAMLprim value llvm_ditype_get_align_in_bits(LLVMMetadataRef DType) { + uint32_t Size = LLVMDITypeGetAlignInBits(DType); + return Val_int(Size); +} + +CAMLprim value llvm_ditype_get_line(LLVMMetadataRef DType) { + unsigned Line = LLVMDITypeGetLine(DType); + return Val_int(Line); +} + +CAMLprim value llvm_ditype_get_flags(LLVMMetadataRef DType) { + LLVMDIFlags Flags = LLVMDITypeGetLine(DType); + return alloc_diflags(Flags); +} + +CAMLprim value llvm_get_subprogram(LLVMValueRef Func) { + return (ptr_to_option(LLVMGetSubprogram(Func))); +} + +CAMLprim value llvm_set_subprogram(LLVMValueRef Func, LLVMMetadataRef SP) { + LLVMSetSubprogram(Func, SP); + return Val_unit; +} + +CAMLprim value llvm_di_subprogram_get_line(LLVMMetadataRef Subprogram) { + return Int_val(LLVMDISubprogramGetLine(Subprogram)); +} + +CAMLprim value llvm_instruction_get_debug_loc(LLVMValueRef Inst) { + return (ptr_to_option(LLVMInstructionGetDebugLoc(Inst))); +} + +CAMLprim value llvm_instruction_set_debug_loc(LLVMValueRef Inst, + LLVMMetadataRef Loc) { + LLVMInstructionSetDebugLoc(Inst, Loc); + return Val_unit; +} + +/* llmetadata -> llvariable option */ +CAMLprim value +llvm_di_global_variable_expression_get_variable(LLVMMetadataRef GVE) { + return (ptr_to_option(LLVMDIGlobalVariableExpressionGetVariable(GVE))); +} + +/* llvariable -> int */ +CAMLprim value llvm_di_variable_get_line(LLVMMetadataRef Variable) { + return Val_int(LLVMDIVariableGetLine(Variable)); +} + +/* llvariable -> llfile option */ +CAMLprim value llvm_di_variable_get_file(LLVMMetadataRef Variable) { + return (ptr_to_option(LLVMDIVariableGetFile(Variable))); +} + +CAMLprim value llvm_get_metadata_kind(LLVMMetadataRef Metadata) { + return Val_int(LLVMGetMetadataKind(Metadata)); +} Index: llvm/bindings/ocaml/debuginfo/llvm_debuginfo.ml =================================================================== --- /dev/null +++ llvm/bindings/ocaml/debuginfo/llvm_debuginfo.ml @@ -0,0 +1,537 @@ +(*===-- 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 + * + *===----------------------------------------------------------------------===*) + +type lldibuilder + +type llmetadata = Llvm.llmetadata + +(** Source languages known by DWARF. *) +module DWARFSourceLanguageKind = struct + type t = + | C89 + | C + | Ada83 + | C_plus_plus + | Cobol74 + | Cobol85 + | Fortran77 + | Fortran90 + | Pascal83 + | Modula2 + (* New in DWARF v3: *) + | LLVMJava + | C99 + | Ada95 + | Fortran95 + | PLI + | ObjC + | ObjC_plus_plus + | UPC + | D + (* New in DWARF v4: *) + | LLVMPython + (* New in DWARF v5: *) + | LLVMOpenCL + | Go + | Modula3 + | Haskell + | C_plus_plus_03 + | C_plus_plus_11 + | OCaml + | Rust + | C11 + | Swift + | Julia + | Dylan + | C_plus_plus_14 + | Fortran03 + | Fortran08 + | RenderScript + | BLISS + (* Vendor extensions: *) + | LLVMMips_Assembler + | GOOGLE_RenderScript + | BORLAND_Delphi +end + +module DIFlag = struct + type t = + | Zero + | Private + | Protected + | Public + | FwdDecl + | AppleBlock + | ReservedBit4 + | Virtual + | Artificial + | Explicit + | Prototyped + | ObjcClassComplete + | ObjectPointer + | Vector + | StaticMember + | LValueReference + | RValueReference + | Reserved + | SingleInheritance + | MultipleInheritance + | VirtualInheritance + | IntroducedVirtual + | BitField + | NoReturn + | TypePassByValue + | TypePassByReference + | EnumClass + | FixedEnum + | Thunk + | NonTrivial + | BigEndian + | LittleEndian + | IndirectVirtualBase + | Accessibility + | PtrToMemberRep +end + +type lldiflags + +external diflags_get : DIFlag.t -> lldiflags = "llvm_diflags_get" + +external diflags_set : lldiflags -> DIFlag.t -> lldiflags = "llvm_diflags_set" + +external diflags_test : lldiflags -> DIFlag.t -> bool = "llvm_diflags_test" + +(** The kind of metadata nodes. *) +module MetadataKind = struct + type t = + | MDStringMetadataKind + | ConstantAsMetadataMetadataKind + | LocalAsMetadataMetadataKind + | DistinctMDOperandPlaceholderMetadataKind + | MDTupleMetadataKind + | DILocationMetadataKind + | DIExpressionMetadataKind + | DIGlobalVariableExpressionMetadataKind + | GenericDINodeMetadataKind + | DISubrangeMetadataKind + | DIEnumeratorMetadataKind + | DIBasicTypeMetadataKind + | DIDerivedTypeMetadataKind + | DICompositeTypeMetadataKind + | DISubroutineTypeMetadataKind + | DIFileMetadataKind + | DICompileUnitMetadataKind + | DISubprogramMetadataKind + | DILexicalBlockMetadataKind + | DILexicalBlockFileMetadataKind + | DINamespaceMetadataKind + | DIModuleMetadataKind + | DITemplateTypeParameterMetadataKind + | DITemplateValueParameterMetadataKind + | DIGlobalVariableMetadataKind + | DILocalVariableMetadataKind + | DILabelMetadataKind + | DIObjCPropertyMetadataKind + | DIImportedEntityMetadataKind + | DIMacroMetadataKind + | DIMacroFileMetadataKind + | DICommonBlockMetadataKind +end + +(** The amount of debug information to emit. *) +module DWARFEmissionKind = struct + type t = None | Full | LineTablesOnly +end + +external debug_metadata_version : unit -> int = "llvm_debug_metadata_version" + +external get_module_debug_metadata_version : Llvm.llmodule -> int + = "llvm_get_module_debug_metadata_version" + +external dibuilder : Llvm.llmodule -> lldibuilder = "llvm_dibuilder" + +external dibuild_finalize : lldibuilder -> unit = "llvm_dibuild_finalize" + +(* See LLVMDIBuilderCreateCompileUnit for argument details. *) +external dibuild_create_compile_unit : + lldibuilder -> + DWARFSourceLanguageKind.t -> + file_ref:llmetadata -> + producer:string -> + is_optimized:bool -> + flags:string -> + runtime_ver:int -> + split_name:string -> + DWARFEmissionKind.t -> + dwoid:int -> + di_inlining:bool -> + di_profiling:bool -> + sys_root:string -> + sdk:string -> + llmetadata + = "llvm_dibuild_create_compile_unit_bytecode" "llvm_dibuild_create_compile_unit_native" + +external dibuild_create_file : + lldibuilder -> filename:string -> directory:string -> llmetadata + = "llvm_dibuild_create_file" + +external dibuild_create_module : + lldibuilder -> + parent_ref:llmetadata -> + name:string -> + config_macros:string -> + include_path:string -> + sys_root:string -> + llmetadata + = "llvm_dibuild_create_module_bytecode" "llvm_dibuild_create_module_native" + +external dibuild_create_namespace : + lldibuilder -> + parent_ref:llmetadata -> + name:string -> + bool:string -> + llmetadata = "llvm_dibuild_create_namespace" + +external dibuild_create_function : + lldibuilder -> + scope:llmetadata -> + name:string -> + linkage_name:string -> + file:llmetadata -> + line_no:int -> + ty:llmetadata -> + is_local_to_unit:bool -> + is_definition:bool -> + scope_line:int -> + flags:lldiflags -> + is_optimized:bool -> + llmetadata + = "llvm_dibuild_create_function_bytecode" "llvm_dibuild_create_function_native" + +external dibuild_create_lexical_block : + lldibuilder -> + scope:llmetadata -> + file:llmetadata -> + line:int -> + column:int -> + llmetadata = "llvm_dibuild_create_lexical_block" + +external dibuild_create_debug_location_helper : + Llvm.llcontext -> + line:int -> + column:int -> + scope:llmetadata -> + inlined_at:llmetadata -> + llmetadata = "llvm_dibuild_create_debug_location" + +external llmetadata_null : unit -> llmetadata = "llvm_metadata_null" + +let dibuild_create_debug_location ?(inlined_at = llmetadata_null ()) llctx ~line + ~column ~scope = + dibuild_create_debug_location_helper llctx line column scope inlined_at + +external di_location_get_line : location:llmetadata -> int + = "llvm_di_location_get_line" + +external di_location_get_column : location:llmetadata -> int + = "llvm_di_location_get_column" + +external di_location_get_scope : location:llmetadata -> llmetadata + = "llvm_di_location_get_scope" + +external di_location_get_inlined_at : location:llmetadata -> llmetadata + = "llvm_di_location_get_inlined_at" + +external di_scope_get_file : scope:llmetadata -> llmetadata + = "llvm_di_scope_get_file" + +external di_file_get_directory : file:llmetadata -> string + = "llvm_di_file_get_directory" + +external di_file_get_filename : file:llmetadata -> string + = "llvm_di_file_get_filename" + +external di_file_get_source : file:llmetadata -> string + = "llvm_di_file_get_source" + +external dibuild_get_or_create_type_array : + lldibuilder -> data:llmetadata array -> llmetadata + = "llvm_dibuild_get_or_create_type_array" + +external dibuild_create_subroutine_type : + lldibuilder -> + file:llmetadata -> + param_types:llmetadata array -> + lldiflags -> + llmetadata = "llvm_dibuild_create_subroutine_type" + +external dibuild_create_enumerator : + lldibuilder -> name:string -> value:int -> is_unsigned:bool -> llmetadata + = "llvm_dibuild_create_enumerator" + +external dibuild_create_enumeration_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + elements:llmetadata array -> + class_ty:llmetadata -> + llmetadata + = "llvm_dibuild_create_enumeration_type_native" "llvm_dibuild_create_enumeration_type_bytecode" + +external dibuild_create_union_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + lldiflags -> + elements:llmetadata array -> + run_time_language:int -> + unique_id:string -> + llmetadata + = "llvm_dibuild_create_union_type_native" "llvm_dibuild_create_union_type_bytecode" + +external dibuild_create_array_type : + lldibuilder -> + size:int -> + align_in_bits:int -> + ty:llmetadata -> + subscripts:llmetadata array -> + llmetadata = "llvm_dibuild_create_array_type" + +external dibuild_create_vector_type : + lldibuilder -> + size:int -> + align_in_bits:int -> + ty:llmetadata -> + subscripts:llmetadata array -> + llmetadata = "llvm_dibuild_create_array_type" + +external dibuild_create_unspecified_type : + lldibuilder -> name:string -> llmetadata + = "llvm_dibuild_create_unspecified_type" + +external dibuild_create_basic_type : + lldibuilder -> + name:string -> + size_in_bits:int -> + encoding:int -> + lldiflags -> + llmetadata = "llvm_dibuild_create_basic_type" + +external dibuild_create_pointer_type : + lldibuilder -> + pointee_ty:llmetadata -> + size_in_bits:int -> + align_in_bits:int -> + address_space:int -> + name:string -> + llmetadata + = "llvm_dibuild_create_pointer_type_native" "llvm_dibuild_create_pointer_type_bytecode" + +external dibuild_create_struct_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + lldiflags -> + derived_from:llmetadata -> + elements:llmetadata array -> + run_time_lang:int -> + vtable_holder:llmetadata -> + unique_id:string -> + llmetadata + = "llvm_dibuild_create_struct_type_native" "llvm_dibuild_create_struct_type_bytecode" + +external dibuild_create_member_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + offset_in_bits:int -> + lldiflags -> + ty:llmetadata -> + llmetadata + = "llvm_dibuild_create_member_type_native" "llvm_dibuild_create_member_type_bytecode" + +external dibuild_create_static_member_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + ty:llmetadata -> + lldiflags -> + const_val:Llvm.llvalue -> + align_in_bits:int -> + llmetadata + = "llvm_dibuild_create_static_member_type_native" "llvm_dibuild_create_static_member_type_bytecode" + +external dibuild_create_member_pointer_type : + lldibuilder -> + pointee_type:llmetadata -> + class_type:llmetadata -> + size_in_bits:int -> + align_in_bits:int -> + lldiflags -> + llmetadata + = "llvm_dibuild_create_member_pointer_type_native" "llvm_dibuild_create_member_pointer_type_bytecode" + +external dibuild_create_object_pointer_type : + lldibuilder -> llmetadata -> llmetadata + = "llvm_dibuild_create_object_pointer_type" + +external dibuild_create_qualified_type : + lldibuilder -> tag:int -> llmetadata -> llmetadata + = "llvm_dibuild_create_qualified_type" + +external dibuild_create_reference_type : + lldibuilder -> tag:int -> llmetadata -> llmetadata + = "llvm_dibuild_create_reference_type" + +external dibuild_create_null_ptr_type : lldibuilder -> llmetadata + = "llvm_dibuild_create_null_ptr_type" + +external dibuild_create_typedef : + lldibuilder -> + ty:llmetadata -> + name:string -> + file:llmetadata -> + line_no:int -> + scope:llmetadata -> + align_in_bits:int -> + llmetadata + = "llvm_dibuild_create_typedef_native" "llvm_dibuild_create_typedef_bytecode" + +external dibuild_create_inheritance_native : + lldibuilder -> + ty:llmetadata -> + base_ty:llmetadata -> + base_offset:int -> + vb_ptr_offset:int -> + lldiflags -> + llmetadata + = "llvm_dibuild_create_inheritance_native" "llvm_dibuild_create_inheritance_bytecode" + +external dibuild_create_forward_decl : + lldibuilder -> + tag:int -> + name:string -> + scope:llmetadata -> + file:llmetadata -> + line:int -> + runtime_lang:int -> + size_in_bits:int -> + align_in_bits:int -> + unique_identifier:string -> + llmetadata + = "llvm_dibuild_create_forward_decl_native" "llvm_dibuild_create_forward_decl_bytecode" + +external dibuild_create_replaceable_composite_type : + lldibuilder -> + tag:int -> + name:string -> + scope:llmetadata -> + file:llmetadata -> + line:int -> + runtime_lang:int -> + size_in_bits:int -> + align_in_bits:int -> + lldiflags -> + unique_identifier:string -> + llmetadata + = "llvm_dibuild_create_replaceable_composite_type_native" "llvm_dibuild_create_replaceable_composite_type_bytecode" + +external dibuild_create_bit_field_member_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_num:int -> + size_in_bits:int -> + offset_in_bits:int -> + storage_offset_in_bits:int -> + lldiflags -> + ty:llmetadata -> + llmetadata + = "llvm_dibuild_create_bit_field_member_type_native" "llvm_dibuild_create_bit_field_member_type_bytecode" + +external dibuild_create_class_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + offset_in_bits:int -> + lldiflags -> + derived_from:llmetadata -> + elements:llmetadata array -> + vtable_holder:llmetadata -> + template_params_node:llmetadata -> + unique_identifier:string -> + llmetadata + = "llvm_dibuild_create_class_type_native" "llvm_dibuild_create_class_type_bytecode" + +external dibuild_create_artificial_type : + lldibuilder -> ty:llmetadata -> llmetadata + = "llvm_dibuild_create_artificial_type" + +external ditype_get_name : llmetadata -> string = "llvm_ditype_get_name" + +external ditype_get_size_in_bits : llmetadata -> int + = "llvm_ditype_get_size_in_bits" + +external ditype_get_offset_in_bits : llmetadata -> int + = "llvm_ditype_get_offset_in_bits" + +external ditype_get_align_in_bits : llmetadata -> int + = "llvm_ditype_get_align_in_bits" + +external ditype_get_line : llmetadata -> int = "llvm_ditype_get_line" + +external ditype_get_flags : llmetadata -> lldiflags = "llvm_ditype_get_flags" + +external get_subprogram : Llvm.llvalue -> llmetadata = "llvm_get_subprogram" + +external set_subprogram : Llvm.llvalue -> llmetadata -> unit + = "llvm_set_subprogram" + +external di_subprogram_get_line : llmetadata -> int + = "llvm_di_subprogram_get_line" + +external instruction_get_debug_loc : Llvm.llvalue -> llmetadata + = "llvm_instruction_get_debug_loc" + +external instruction_set_debug_loc : Llvm.llvalue -> llmetadata -> unit + = "llvm_instruction_set_debug_loc" + +external di_global_variable_expression_get_variable : + llmetadata -> llmetadata option + = "llvm_di_global_variable_expression_get_variable" + +external di_variable_get_line : llmetadata -> int = "llvm_di_variable_get_line" + +external di_variable_get_file : llmetadata -> llmetadata option + = "llvm_di_variable_get_file" + +external get_metadata_kind : llmetadata -> MetadataKind.t + = "llvm_get_metadata_kind" Index: llvm/bindings/ocaml/debuginfo/llvm_debuginfo.mli =================================================================== --- /dev/null +++ llvm/bindings/ocaml/debuginfo/llvm_debuginfo.mli @@ -0,0 +1,492 @@ +(*===-- llvm_analysis.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 + * + *===----------------------------------------------------------------------===*) + +type lldibuilder + +type llmetadata = Llvm.llmetadata + +(** Source languages known by DWARF. *) +module DWARFSourceLanguageKind : sig + type t = + | C89 + | C + | Ada83 + | C_plus_plus + | Cobol74 + | Cobol85 + | Fortran77 + | Fortran90 + | Pascal83 + | Modula2 + (* New in DWARF v3: *) + | LLVMJava + | C99 + | Ada95 + | Fortran95 + | PLI + | ObjC + | ObjC_plus_plus + | UPC + | D + (* New in DWARF v4: *) + | LLVMPython + (* New in DWARF v5: *) + | LLVMOpenCL + | Go + | Modula3 + | Haskell + | C_plus_plus_03 + | C_plus_plus_11 + | OCaml + | Rust + | C11 + | Swift + | Julia + | Dylan + | C_plus_plus_14 + | Fortran03 + | Fortran08 + | RenderScript + | BLISS + (* Vendor extensions: *) + | LLVMMips_Assembler + | GOOGLE_RenderScript + | BORLAND_Delphi +end + +module DIFlag : sig + type t = + | Zero + | Private + | Protected + | Public + | FwdDecl + | AppleBlock + | ReservedBit4 + | Virtual + | Artificial + | Explicit + | Prototyped + | ObjcClassComplete + | ObjectPointer + | Vector + | StaticMember + | LValueReference + | RValueReference + | Reserved + | SingleInheritance + | MultipleInheritance + | VirtualInheritance + | IntroducedVirtual + | BitField + | NoReturn + | TypePassByValue + | TypePassByReference + | EnumClass + | FixedEnum + | Thunk + | NonTrivial + | BigEndian + | LittleEndian + | IndirectVirtualBase + | Accessibility + | PtrToMemberRep +end + +type lldiflags +(** An opaque type to represent OR of multiple DIFlag.t. *) + +val diflags_get : DIFlag.t -> lldiflags + +val diflags_set : lldiflags -> DIFlag.t -> lldiflags + +val diflags_test : lldiflags -> DIFlag.t -> bool + +(** The kind of metadata nodes. *) +module MetadataKind : sig + type t = + | MDStringMetadataKind + | ConstantAsMetadataMetadataKind + | LocalAsMetadataMetadataKind + | DistinctMDOperandPlaceholderMetadataKind + | MDTupleMetadataKind + | DILocationMetadataKind + | DIExpressionMetadataKind + | DIGlobalVariableExpressionMetadataKind + | GenericDINodeMetadataKind + | DISubrangeMetadataKind + | DIEnumeratorMetadataKind + | DIBasicTypeMetadataKind + | DIDerivedTypeMetadataKind + | DICompositeTypeMetadataKind + | DISubroutineTypeMetadataKind + | DIFileMetadataKind + | DICompileUnitMetadataKind + | DISubprogramMetadataKind + | DILexicalBlockMetadataKind + | DILexicalBlockFileMetadataKind + | DINamespaceMetadataKind + | DIModuleMetadataKind + | DITemplateTypeParameterMetadataKind + | DITemplateValueParameterMetadataKind + | DIGlobalVariableMetadataKind + | DILocalVariableMetadataKind + | DILabelMetadataKind + | DIObjCPropertyMetadataKind + | DIImportedEntityMetadataKind + | DIMacroMetadataKind + | DIMacroFileMetadataKind + | DICommonBlockMetadataKind +end + +(** The amount of debug information to emit. *) +module DWARFEmissionKind : sig + type t = None | Full | LineTablesOnly +end + +val debug_metadata_version : unit -> int + +val get_module_debug_metadata_version : Llvm.llmodule -> int + +val dibuilder : Llvm.llmodule -> lldibuilder + +val dibuild_finalize : lldibuilder -> unit + +val dibuild_create_compile_unit : + lldibuilder -> + DWARFSourceLanguageKind.t -> + file_ref:llmetadata -> + producer:string -> + is_optimized:bool -> + flags:string -> + runtime_ver:int -> + split_name:string -> + DWARFEmissionKind.t -> + dwoid:int -> + di_inlining:bool -> + di_profiling:bool -> + sys_root:string -> + sdk:string -> + llmetadata + +val dibuild_create_file : + lldibuilder -> filename:string -> directory:string -> llmetadata + +val dibuild_create_module : + lldibuilder -> + parent_ref:llmetadata -> + name:string -> + config_macros:string -> + include_path:string -> + sys_root:string -> + llmetadata + +val dibuild_create_namespace : + lldibuilder -> + parent_ref:llmetadata -> + name:string -> + bool:string -> + llmetadata + +val dibuild_create_function : + lldibuilder -> + scope:llmetadata -> + name:string -> + linkage_name:string -> + file:llmetadata -> + line_no:int -> + ty:llmetadata -> + is_local_to_unit:bool -> + is_definition:bool -> + scope_line:int -> + flags:lldiflags -> + is_optimized:bool -> + llmetadata + +val dibuild_create_lexical_block : + lldibuilder -> + scope:llmetadata -> + file:llmetadata -> + line:int -> + column:int -> + llmetadata + +val llmetadata_null : unit -> llmetadata + +val dibuild_create_debug_location : + ?inlined_at:llmetadata -> + Llvm.llcontext -> + line:int -> + column:int -> + scope:llmetadata -> + llmetadata + +val di_location_get_line : location:llmetadata -> int + +val di_location_get_column : location:llmetadata -> int + +val di_location_get_scope : location:llmetadata -> llmetadata + +val di_location_get_inlined_at : location:llmetadata -> llmetadata + +val di_scope_get_file : scope:llmetadata -> llmetadata + +val di_file_get_directory : file:llmetadata -> string + +val di_file_get_filename : file:llmetadata -> string + +val di_file_get_source : file:llmetadata -> string + +val dibuild_get_or_create_type_array : + lldibuilder -> data:llmetadata array -> llmetadata + +val dibuild_create_subroutine_type : + lldibuilder -> + file:llmetadata -> + param_types:llmetadata array -> + lldiflags -> + llmetadata + +val dibuild_create_enumerator : + lldibuilder -> name:string -> value:int -> is_unsigned:bool -> llmetadata + +val dibuild_create_enumeration_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + elements:llmetadata array -> + class_ty:llmetadata -> + llmetadata + +val dibuild_create_union_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + lldiflags -> + elements:llmetadata array -> + run_time_language:int -> + unique_id:string -> + llmetadata + +val dibuild_create_array_type : + lldibuilder -> + size:int -> + align_in_bits:int -> + ty:llmetadata -> + subscripts:llmetadata array -> + llmetadata + +val dibuild_create_vector_type : + lldibuilder -> + size:int -> + align_in_bits:int -> + ty:llmetadata -> + subscripts:llmetadata array -> + llmetadata + +val dibuild_create_unspecified_type : lldibuilder -> name:string -> llmetadata + +val dibuild_create_basic_type : + lldibuilder -> + name:string -> + size_in_bits:int -> + encoding:int -> + lldiflags -> + llmetadata + +val dibuild_create_pointer_type : + lldibuilder -> + pointee_ty:llmetadata -> + size_in_bits:int -> + align_in_bits:int -> + address_space:int -> + name:string -> + llmetadata + +val dibuild_create_struct_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + lldiflags -> + derived_from:llmetadata -> + elements:llmetadata array -> + run_time_lang:int -> + vtable_holder:llmetadata -> + unique_id:string -> + llmetadata + +val dibuild_create_member_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + offset_in_bits:int -> + lldiflags -> + ty:llmetadata -> + llmetadata + +val dibuild_create_static_member_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + ty:llmetadata -> + lldiflags -> + const_val:Llvm.llvalue -> + align_in_bits:int -> + llmetadata + +val dibuild_create_member_pointer_type : + lldibuilder -> + pointee_type:llmetadata -> + class_type:llmetadata -> + size_in_bits:int -> + align_in_bits:int -> + lldiflags -> + llmetadata + +val dibuild_create_object_pointer_type : lldibuilder -> llmetadata -> llmetadata + +val dibuild_create_qualified_type : + lldibuilder -> tag:int -> llmetadata -> llmetadata + +val dibuild_create_reference_type : + lldibuilder -> tag:int -> llmetadata -> llmetadata + +val dibuild_create_null_ptr_type : lldibuilder -> llmetadata + +val dibuild_create_typedef : + lldibuilder -> + ty:llmetadata -> + name:string -> + file:llmetadata -> + line_no:int -> + scope:llmetadata -> + align_in_bits:int -> + llmetadata + +val dibuild_create_inheritance_native : + lldibuilder -> + ty:llmetadata -> + base_ty:llmetadata -> + base_offset:int -> + vb_ptr_offset:int -> + lldiflags -> + llmetadata + +val dibuild_create_forward_decl : + lldibuilder -> + tag:int -> + name:string -> + scope:llmetadata -> + file:llmetadata -> + line:int -> + runtime_lang:int -> + size_in_bits:int -> + align_in_bits:int -> + unique_identifier:string -> + llmetadata + +val dibuild_create_replaceable_composite_type : + lldibuilder -> + tag:int -> + name:string -> + scope:llmetadata -> + file:llmetadata -> + line:int -> + runtime_lang:int -> + size_in_bits:int -> + align_in_bits:int -> + lldiflags -> + unique_identifier:string -> + llmetadata + +val dibuild_create_bit_field_member_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_num:int -> + size_in_bits:int -> + offset_in_bits:int -> + storage_offset_in_bits:int -> + lldiflags -> + ty:llmetadata -> + llmetadata + +val dibuild_create_class_type : + lldibuilder -> + scope:llmetadata -> + name:string -> + file:llmetadata -> + line_number:int -> + size_in_bits:int -> + align_in_bits:int -> + offset_in_bits:int -> + lldiflags -> + derived_from:llmetadata -> + elements:llmetadata array -> + vtable_holder:llmetadata -> + template_params_node:llmetadata -> + unique_identifier:string -> + llmetadata + +val dibuild_create_artificial_type : lldibuilder -> ty:llmetadata -> llmetadata + +val ditype_get_name : llmetadata -> string + +val ditype_get_size_in_bits : llmetadata -> int + +val ditype_get_offset_in_bits : llmetadata -> int + +val ditype_get_align_in_bits : llmetadata -> int + +val ditype_get_line : llmetadata -> int + +val ditype_get_flags : llmetadata -> lldiflags + +val get_subprogram : Llvm.llvalue -> llmetadata + +val set_subprogram : Llvm.llvalue -> llmetadata -> unit + +val di_subprogram_get_line : llmetadata -> int + +val instruction_get_debug_loc : Llvm.llvalue -> llmetadata + +val instruction_set_debug_loc : Llvm.llvalue -> llmetadata -> unit + +val di_global_variable_expression_get_variable : llmetadata -> llmetadata option +(** [di_global_variable_expression_get_variable gve] returns the debug variable + of [gve], which must be a [DIGlobalVariableExpression]. + See the [llvm::DIGlobalVariableExpression::getVariable()] method. *) + +val di_variable_get_line : llmetadata -> int +(** [di_variable_get_line v] returns the line number of the variable [v]. + See the [llvm::DIVariable::getLine()] method. *) + +val di_variable_get_file : llmetadata -> llmetadata option +(** [di_variable_get_file v] returns the file of the variable [v]. + See the [llvm::DIVariable::getFile()] method. *) + +val get_metadata_kind : llmetadata -> MetadataKind.t Index: llvm/bindings/ocaml/llvm/META.llvm.in =================================================================== --- llvm/bindings/ocaml/llvm/META.llvm.in +++ llvm/bindings/ocaml/llvm/META.llvm.in @@ -45,6 +45,14 @@ archive(native) = "llvm_ipo.cmxa" ) +package "debuginfo" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "DebugInfo support for LLVM" + archive(byte) = "llvm_debuginfo.cma" + archive(native) = "llvm_debuginfo.cmxa" +) + package "irreader" ( requires = "llvm" version = "@PACKAGE_VERSION@" Index: llvm/bindings/ocaml/llvm/llvm.ml =================================================================== --- llvm/bindings/ocaml/llvm/llvm.ml +++ llvm/bindings/ocaml/llvm/llvm.ml @@ -9,6 +9,7 @@ type llcontext type llmodule +type llmetadata type lltype type llvalue type lluse @@ -326,6 +327,16 @@ | Note end +module ModuleFlagBehaviour = struct + type t = + | Error + | Warning + | Require + | Override + | Append + | AppendUnique +end + exception IoError of string let () = Callback.register_exception "Llvm.IoError" (IoError "") @@ -425,6 +436,10 @@ external set_module_inline_asm : llmodule -> string -> unit = "llvm_set_module_inline_asm" external module_context : llmodule -> llcontext = "LLVMGetModuleContext" +external get_module_flag : llmodule -> string -> llmetadata + = "llvm_get_module_flag" +external add_module_flag : llmodule -> ModuleFlagBehaviour.t -> + string -> llmetadata -> unit = "llvm_add_module_flag" (*===-- Types -------------------------------------------------------------===*) external classify_type : lltype -> TypeKind.t = "llvm_classify_type" @@ -571,6 +586,9 @@ = "llvm_get_namedmd" external add_named_metadata_operand : llmodule -> string -> llvalue -> unit = "llvm_append_namedmd" +external value_as_metadata : llvalue -> llmetadata = "llvm_value_as_metadata" +external metadata_as_value : llcontext -> llmetadata -> llvalue + = "llvm_metadata_as_value" (*--... Operations on scalar constants .....................................--*) external const_int : lltype -> int -> llvalue = "llvm_const_int" @@ -695,6 +713,8 @@ 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" Index: llvm/bindings/ocaml/llvm/llvm.mli =================================================================== --- llvm/bindings/ocaml/llvm/llvm.mli +++ llvm/bindings/ocaml/llvm/llvm.mli @@ -24,6 +24,9 @@ objects. See the [llvm::Module] class. *) type llmodule +(** Opaque representation of Metadata nodes. See the [llvm::Metadata] class. *) +type llmetadata + (** Each value in the LLVM IR has a type, an instance of [lltype]. See the [llvm::Type] class. *) type lltype @@ -361,6 +364,15 @@ | Note end +module ModuleFlagBehaviour :sig + type t = + | Error + | Warning + | Require + | Override + | Append + | AppendUnique +end (** {6 Iteration} *) @@ -525,7 +537,9 @@ See the method [llvm::Module::getContext] *) val module_context : llmodule -> llcontext - +val get_module_flag : llmodule -> string -> llmetadata +val add_module_flag : llmodule -> ModuleFlagBehaviour.t -> + string -> llmetadata -> unit (** {6 Types} *) (** [classify_type ty] returns the {!TypeKind.t} corresponding to the type [ty]. @@ -919,6 +933,13 @@ [llvm::MDNode::addOperand()]. *) val add_named_metadata_operand : llmodule -> string -> llvalue -> unit +(** Obtain a Value as a Metadata. + See the method [llvm::ValueAsMetadata::get()]. *) +val value_as_metadata : llvalue -> llmetadata + +(** Obtain a Value as a Metadata. + See the method [llvm::MetadataAsValue::get()]. *) +val metadata_as_value : llcontext -> llmetadata -> llvalue (** {7 Operations on scalar constants} *) @@ -1378,6 +1399,12 @@ [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} *) Index: llvm/bindings/ocaml/llvm/llvm_ocaml.c =================================================================== --- llvm/bindings/ocaml/llvm/llvm_ocaml.c +++ llvm/bindings/ocaml/llvm/llvm_ocaml.c @@ -319,6 +319,19 @@ return Val_unit; } +/* llmodule -> string -> llmetadata */ +CAMLprim LLVMMetadataRef llvm_get_module_flag(LLVMModuleRef M, value Key) { + return LLVMGetModuleFlag(M, String_val(Key), caml_string_length(Key)); +} + +CAMLprim value llvm_add_module_flag(LLVMModuleRef M, + LLVMModuleFlagBehavior Behaviour, value Key, + LLVMMetadataRef Val) { + LLVMAddModuleFlag(M, Int_val(Behaviour), String_val(Key), + caml_string_length(Key), Val); + return Val_unit; +} + /*===-- Types -------------------------------------------------------------===*/ /* lltype -> TypeKind.t */ @@ -870,6 +883,17 @@ return Val_unit; } +/* llvalue -> llmetadata */ +CAMLprim LLVMMetadataRef llvm_value_as_metadata(LLVMValueRef Val) { + return LLVMValueAsMetadata(Val); +} + +/* llcontext -> llmetadata -> llvalue */ +CAMLprim LLVMValueRef llvm_metadata_as_value(LLVMContextRef C, + LLVMMetadataRef MD) { + return LLVMMetadataAsValue(C, MD); +} + /*--... Operations on scalar constants .....................................--*/ /* lltype -> int -> llvalue */ @@ -1160,6 +1184,25 @@ 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 */