diff --git a/clang/include/clang/AST/ASTContext.h b/clang/include/clang/AST/ASTContext.h index e6d5724536472..125742d8d9df8 100644 --- a/clang/include/clang/AST/ASTContext.h +++ b/clang/include/clang/AST/ASTContext.h @@ -239,6 +239,7 @@ class ASTContext : public RefCountedBase { mutable llvm::FoldingSet PipeTypes; mutable llvm::FoldingSet BitIntTypes; mutable llvm::FoldingSet DependentBitIntTypes; + mutable llvm::FoldingSet OCamlRawTypes; llvm::FoldingSet BTFTagAttributedTypes; mutable llvm::FoldingSet QualifiedTemplateNames; @@ -1368,6 +1369,9 @@ class ASTContext : public RefCountedBase { /// and bit count. QualType getDependentBitIntType(bool Unsigned, Expr *BitsExpr) const; + /// Return an OCaml raw data type with the specified bit count. + QualType getOCamlRawType(unsigned NumBits) const; + /// Gets the struct used to keep track of the extended descriptor for /// pointer to blocks. QualType getBlockDescriptorExtendedType() const; diff --git a/clang/include/clang/AST/RecursiveASTVisitor.h b/clang/include/clang/AST/RecursiveASTVisitor.h index 5802e905be46b..1069a323852da 100644 --- a/clang/include/clang/AST/RecursiveASTVisitor.h +++ b/clang/include/clang/AST/RecursiveASTVisitor.h @@ -1156,6 +1156,7 @@ DEF_TRAVERSE_TYPE(PipeType, { TRY_TO(TraverseType(T->getElementType())); }) DEF_TRAVERSE_TYPE(BitIntType, {}) DEF_TRAVERSE_TYPE(DependentBitIntType, { TRY_TO(TraverseStmt(T->getNumBitsExpr())); }) +DEF_TRAVERSE_TYPE(OCamlRawType, {}) #undef DEF_TRAVERSE_TYPE @@ -1456,6 +1457,7 @@ DEF_TRAVERSE_TYPELOC(BitIntType, {}) DEF_TRAVERSE_TYPELOC(DependentBitIntType, { TRY_TO(TraverseStmt(TL.getTypePtr()->getNumBitsExpr())); }) +DEF_TRAVERSE_TYPELOC(OCamlRawType, {}) #undef DEF_TRAVERSE_TYPELOC diff --git a/clang/include/clang/AST/Type.h b/clang/include/clang/AST/Type.h index 180251d7f6bd8..b8e2d4d587bd2 100644 --- a/clang/include/clang/AST/Type.h +++ b/clang/include/clang/AST/Type.h @@ -6541,6 +6541,33 @@ class BitIntType final : public Type, public llvm::FoldingSetNode { static bool classof(const Type *T) { return T->getTypeClass() == BitInt; } }; +/// OCaml raw data type with specified bit width for LLDB debugging +class OCamlRawType final : public Type, public llvm::FoldingSetNode { + friend class ASTContext; + unsigned NumBits : 24; + +protected: + OCamlRawType(unsigned NumBits); + +public: + unsigned getNumBits() const { return NumBits; } + + bool isSugared() const { return false; } + QualType desugar() const { return QualType(this, 0); } + + void Profile(llvm::FoldingSetNodeID &ID) { + Profile(ID, getNumBits()); + } + + static void Profile(llvm::FoldingSetNodeID &ID, unsigned NumBits) { + ID.AddInteger(NumBits); + } + + static bool classof(const Type *T) { + return T->getTypeClass() == OCamlRaw; + } +}; + class DependentBitIntType final : public Type, public llvm::FoldingSetNode { friend class ASTContext; const ASTContext &Context; diff --git a/clang/include/clang/AST/TypeLoc.h b/clang/include/clang/AST/TypeLoc.h index 72ed3cb752e0f..a698d14dbbb1f 100644 --- a/clang/include/clang/AST/TypeLoc.h +++ b/clang/include/clang/AST/TypeLoc.h @@ -2655,6 +2655,10 @@ class DependentBitIntTypeLoc final : public InheritingConcreteTypeLoc {}; +class OCamlRawTypeLoc final + : public InheritingConcreteTypeLoc {}; + class ObjCProtocolLoc { ObjCProtocolDecl *Protocol = nullptr; SourceLocation Loc = SourceLocation(); diff --git a/clang/include/clang/AST/TypeProperties.td b/clang/include/clang/AST/TypeProperties.td index aca445fbe6cef..82c9e533f920c 100644 --- a/clang/include/clang/AST/TypeProperties.td +++ b/clang/include/clang/AST/TypeProperties.td @@ -946,3 +946,13 @@ let Class = DependentBitIntType in { return ctx.getDependentBitIntType(isUnsigned, numBitsExpr); }]>; } + +let Class = OCamlRawType in { + def : Property<"numBits", UInt32> { + let Read = [{ node->getNumBits() }]; + } + + def : Creator<[{ + return ctx.getOCamlRawType(numBits); + }]>; +} diff --git a/clang/include/clang/Basic/TypeNodes.td b/clang/include/clang/Basic/TypeNodes.td index f8557d02e5bd6..69ff527637723 100644 --- a/clang/include/clang/Basic/TypeNodes.td +++ b/clang/include/clang/Basic/TypeNodes.td @@ -111,3 +111,4 @@ def PipeType : TypeNode; def AtomicType : TypeNode; def BitIntType : TypeNode; def DependentBitIntType : TypeNode, AlwaysDependent; +def OCamlRawType : TypeNode; diff --git a/clang/lib/AST/ASTContext.cpp b/clang/lib/AST/ASTContext.cpp index 8a9b5d34f9450..28ef05326c0c0 100644 --- a/clang/lib/AST/ASTContext.cpp +++ b/clang/lib/AST/ASTContext.cpp @@ -2326,6 +2326,12 @@ TypeInfo ASTContext::getTypeInfoImpl(const Type *T) const { Width = llvm::alignTo(EIT->getNumBits(), Align); break; } + case Type::OCamlRaw: { + const auto *ORT = cast(T); + Align = std::min(8U, static_cast(llvm::PowerOf2Ceil(ORT->getNumBits()))); + Width = ORT->getNumBits(); + break; + } case Type::Record: case Type::Enum: { const auto *TT = cast(T); @@ -4587,6 +4593,20 @@ QualType ASTContext::getBitIntType(bool IsUnsigned, unsigned NumBits) const { return QualType(New, 0); } +QualType ASTContext::getOCamlRawType(unsigned NumBits) const { + llvm::FoldingSetNodeID ID; + OCamlRawType::Profile(ID, NumBits); + + void *InsertPos = nullptr; + if (OCamlRawType *ORT = OCamlRawTypes.FindNodeOrInsertPos(ID, InsertPos)) + return QualType(ORT, 0); + + auto *New = new (*this, TypeAlignment) OCamlRawType(NumBits); + OCamlRawTypes.InsertNode(New, InsertPos); + Types.push_back(New); + return QualType(New, 0); +} + QualType ASTContext::getDependentBitIntType(bool IsUnsigned, Expr *NumBitsExpr) const { assert(NumBitsExpr->isInstantiationDependent() && "Only good for dependent"); diff --git a/clang/lib/AST/ItaniumMangle.cpp b/clang/lib/AST/ItaniumMangle.cpp index 57295dab23525..6c0f607793abf 100644 --- a/clang/lib/AST/ItaniumMangle.cpp +++ b/clang/lib/AST/ItaniumMangle.cpp @@ -4053,6 +4053,11 @@ void CXXNameMangler::mangleType(const DependentBitIntType *T) { Out << "_"; } +void CXXNameMangler::mangleType(const OCamlRawType *T) { + // This should never be called in practice for lldb usage + llvm_unreachable("OCamlRaw types should not be mangled"); +} + void CXXNameMangler::mangleIntegerLiteral(QualType T, const llvm::APSInt &Value) { // ::= L E # integer literal diff --git a/clang/lib/AST/MicrosoftMangle.cpp b/clang/lib/AST/MicrosoftMangle.cpp index 2ad505f3279cc..42e3d6cfc24f2 100644 --- a/clang/lib/AST/MicrosoftMangle.cpp +++ b/clang/lib/AST/MicrosoftMangle.cpp @@ -3409,6 +3409,12 @@ void MicrosoftCXXNameMangler::mangleType(const DependentBitIntType *T, Diags.Report(Range.getBegin(), DiagID) << Range; } +void MicrosoftCXXNameMangler::mangleType(const OCamlRawType *T, + Qualifiers, SourceRange Range) { + // This should never be called in practice for lldb usage + llvm_unreachable("OCamlRaw types should not be mangled"); +} + // ::= | | // // ::= A # private near diff --git a/clang/lib/AST/Type.cpp b/clang/lib/AST/Type.cpp index 74025a0c3b4b7..c54849e0c61ce 100644 --- a/clang/lib/AST/Type.cpp +++ b/clang/lib/AST/Type.cpp @@ -342,6 +342,9 @@ BitIntType::BitIntType(bool IsUnsigned, unsigned NumBits) : Type(BitInt, QualType{}, TypeDependence::None), IsUnsigned(IsUnsigned), NumBits(NumBits) {} +OCamlRawType::OCamlRawType(unsigned NumBits) + : Type(OCamlRaw, QualType{}, TypeDependence::None), NumBits(NumBits) {} + DependentBitIntType::DependentBitIntType(const ASTContext &Context, bool IsUnsigned, Expr *NumBitsExpr) : Type(DependentBitInt, QualType{}, diff --git a/clang/lib/AST/TypePrinter.cpp b/clang/lib/AST/TypePrinter.cpp index a65001a7bc5e1..2bfdd29e0557e 100644 --- a/clang/lib/AST/TypePrinter.cpp +++ b/clang/lib/AST/TypePrinter.cpp @@ -246,6 +246,7 @@ bool TypePrinter::canPrefixQualifiers(const Type *T, case Type::Pipe: case Type::BitInt: case Type::DependentBitInt: + case Type::OCamlRaw: case Type::BTFTagAttributed: CanPrefixQualifiers = true; break; @@ -1256,6 +1257,13 @@ void TypePrinter::printDependentBitIntBefore(const DependentBitIntType *T, void TypePrinter::printDependentBitIntAfter(const DependentBitIntType *T, raw_ostream &OS) {} +void TypePrinter::printOCamlRawBefore(const OCamlRawType *T, raw_ostream &OS) { + OS << "ocaml_raw<" << T->getNumBits() << ">"; + spaceBeforePlaceHolder(OS); +} + +void TypePrinter::printOCamlRawAfter(const OCamlRawType *T, raw_ostream &OS) {} + /// Appends the given scope to the end of a string. void TypePrinter::AppendScope(DeclContext *DC, raw_ostream &OS, DeclarationName NameInScope) { diff --git a/clang/lib/Sema/SemaTemplate.cpp b/clang/lib/Sema/SemaTemplate.cpp index 890cea1dfb0ed..916131bc7bb96 100644 --- a/clang/lib/Sema/SemaTemplate.cpp +++ b/clang/lib/Sema/SemaTemplate.cpp @@ -6387,6 +6387,10 @@ bool UnnamedLocalNoLinkageFinder::VisitDependentBitIntType( return false; } +bool UnnamedLocalNoLinkageFinder::VisitOCamlRawType(const OCamlRawType *T) { + return false; +} + bool UnnamedLocalNoLinkageFinder::VisitTagDecl(const TagDecl *Tag) { if (Tag->getDeclContext()->isFunctionOrMethod()) { S.Diag(SR.getBegin(), diff --git a/clang/lib/Sema/TreeTransform.h b/clang/lib/Sema/TreeTransform.h index 4244bbc1e4b13..9494d33726581 100644 --- a/clang/lib/Sema/TreeTransform.h +++ b/clang/lib/Sema/TreeTransform.h @@ -6662,6 +6662,18 @@ QualType TreeTransform::TransformDependentBitIntType( return Result; } +template +QualType TreeTransform::TransformOCamlRawType(TypeLocBuilder &TLB, + OCamlRawTypeLoc TL) { + // OCamlRaw types are never used in template contexts, so just return unchanged + const OCamlRawType *T = TL.getTypePtr(); + QualType Result = QualType(T, 0); + + OCamlRawTypeLoc NewTL = TLB.push(Result); + NewTL.setNameLoc(TL.getNameLoc()); + return Result; +} + /// Simple iterator that traverses the template arguments in a /// container that provides a \c getArgLoc() member function. /// diff --git a/clang/lib/Serialization/ASTReader.cpp b/clang/lib/Serialization/ASTReader.cpp index 4d72596b7439f..f37e9b43f6699 100644 --- a/clang/lib/Serialization/ASTReader.cpp +++ b/clang/lib/Serialization/ASTReader.cpp @@ -6903,6 +6903,10 @@ void TypeLocReader::VisitDependentBitIntTypeLoc( TL.setNameLoc(readSourceLocation()); } +void TypeLocReader::VisitOCamlRawTypeLoc(clang::OCamlRawTypeLoc TL) { + TL.setNameLoc(readSourceLocation()); +} + void ASTRecordReader::readTypeLoc(TypeLoc TL, LocSeq *ParentSeq) { LocSeq::State Seq(ParentSeq); TypeLocReader TLR(*this, Seq); diff --git a/clang/lib/Serialization/ASTWriter.cpp b/clang/lib/Serialization/ASTWriter.cpp index bdf11001473e2..52e658a13410a 100644 --- a/clang/lib/Serialization/ASTWriter.cpp +++ b/clang/lib/Serialization/ASTWriter.cpp @@ -606,6 +606,10 @@ void TypeLocWriter::VisitDependentBitIntTypeLoc( addSourceLocation(TL.getNameLoc()); } +void TypeLocWriter::VisitOCamlRawTypeLoc(clang::OCamlRawTypeLoc TL) { + addSourceLocation(TL.getNameLoc()); +} + void ASTWriter::WriteTypeAbbrevs() { using namespace llvm; diff --git a/clang/tools/libclang/CIndex.cpp b/clang/tools/libclang/CIndex.cpp index 15652c4993454..f0bbb5a22beae 100644 --- a/clang/tools/libclang/CIndex.cpp +++ b/clang/tools/libclang/CIndex.cpp @@ -1910,6 +1910,7 @@ DEFAULT_TYPELOC_IMPL(SubstTemplateTypeParmPack, Type) DEFAULT_TYPELOC_IMPL(Auto, Type) DEFAULT_TYPELOC_IMPL(BitInt, Type) DEFAULT_TYPELOC_IMPL(DependentBitInt, Type) +DEFAULT_TYPELOC_IMPL(OCamlRaw, Type) bool CursorVisitor::VisitCXXRecordDecl(CXXRecordDecl *D) { // Visit the nested-name-specifier, if present. diff --git a/lldb/include/lldb/lldb-enumerations.h b/lldb/include/lldb/lldb-enumerations.h index 1e9688bcd3e9b..7bcc13b385894 100644 --- a/lldb/include/lldb/lldb-enumerations.h +++ b/lldb/include/lldb/lldb-enumerations.h @@ -201,6 +201,7 @@ enum Format { eFormatVoid, ///< Do not print this eFormatUnicode8, eFormatOCamlValue, + eFormatOCamlRaw, kNumFormats }; diff --git a/lldb/source/Commands/CommandObjectMemory.cpp b/lldb/source/Commands/CommandObjectMemory.cpp index 69f3e27a41e14..cc053e8229dba 100644 --- a/lldb/source/Commands/CommandObjectMemory.cpp +++ b/lldb/source/Commands/CommandObjectMemory.cpp @@ -1421,6 +1421,7 @@ class CommandObjectMemoryWrite : public CommandObjectParsed { case eFormatVectorOfFloat64: case eFormatVectorOfUInt128: case eFormatOCamlValue: + case eFormatOCamlRaw: case eFormatOSType: case eFormatComplexInteger: case eFormatAddressInfo: diff --git a/lldb/source/Core/DumpDataExtractor.cpp b/lldb/source/Core/DumpDataExtractor.cpp index 5a395fd3457fd..51d917480356a 100644 --- a/lldb/source/Core/DumpDataExtractor.cpp +++ b/lldb/source/Core/DumpDataExtractor.cpp @@ -424,6 +424,19 @@ void PrintAPIntAsFloat(Stream *s, llvm::APInt apint, } +static offset_t FormatOCamlRaw(const DataExtractor &DE, Stream *s, + offset_t start_offset, size_t item_byte_size) { + offset_t offset = start_offset; + + for (size_t i = 0; i < item_byte_size; ++i) { + if (i > 0) + s->PutChar(' '); + s->Printf("%02x", DE.GetU8(&offset)); + } + + return offset; +} + static offset_t FormatOCamlValue(const DataExtractor &DE, Stream *s, offset_t start_offset, uint64_t base_addr, ExecutionContextScope *exe_ctx_scope, @@ -1296,6 +1309,11 @@ lldb::offset_t lldb_private::DumpDataExtractor( pointers_seen, 0); break; } + + case eFormatOCamlRaw: { + offset = FormatOCamlRaw(DE, s, offset, item_byte_size); + break; + } } } diff --git a/lldb/source/DataFormatters/FormatManager.cpp b/lldb/source/DataFormatters/FormatManager.cpp index dba82883b371f..5c35e9b9b451d 100644 --- a/lldb/source/DataFormatters/FormatManager.cpp +++ b/lldb/source/DataFormatters/FormatManager.cpp @@ -72,6 +72,7 @@ static constexpr FormatInfo g_format_infos[] = { {eFormatVoid, 'v', "void"}, {eFormatUnicode8, 'u', "unicode8"}, {eFormatOCamlValue, '\0', "ocaml_value"}, + {eFormatOCamlRaw, '\0', "ocaml_raw"}, }; static_assert((sizeof(g_format_infos) / sizeof(g_format_infos[0])) == diff --git a/lldb/source/Plugins/TypeSystem/Clang/TypeSystemClang.cpp b/lldb/source/Plugins/TypeSystem/Clang/TypeSystemClang.cpp index 3cbc56e5f43a3..d451ec5eab53e 100644 --- a/lldb/source/Plugins/TypeSystem/Clang/TypeSystemClang.cpp +++ b/lldb/source/Plugins/TypeSystem/Clang/TypeSystemClang.cpp @@ -1060,6 +1060,11 @@ CompilerType TypeSystemClang::GetBuiltinTypeForDWARFEncodingAndBitSize( } if (type_name == "ocaml_value") return GetType(ast.OCamlValueTy); + + if (type_name == "ocaml_raw") { + // Create OCamlRawType with the correct bit size + return GetType(ast.getOCamlRawType(bit_size)); + } } // We weren't able to match up a type name, just search by size if (QualTypeMatchesBitSize(bit_size, ast, ast.CharTy)) @@ -4069,6 +4074,8 @@ TypeSystemClang::GetTypeInfo(lldb::opaque_compiler_type_t type, } return vector_type_flags; } + case clang::Type::OCamlRaw: + return eTypeHasValue | eTypeIsBuiltIn; default: return 0; } @@ -9395,6 +9402,16 @@ bool TypeSystemClang::DumpTypeValue( 0, 0, exe_scope); } + if (qual_type->getTypeClass() == clang::Type::OCamlRaw) { + const clang::OCamlRawType *ocaml_raw_type = + llvm::cast(qual_type.getTypePtr()); + size_t ocaml_raw_byte_size = ocaml_raw_type->getNumBits() / 8; + return DumpDataExtractor(data, s, byte_offset, eFormatOCamlRaw, + ocaml_raw_byte_size, 1, + UINT32_MAX, LLDB_INVALID_ADDRESS, + 0, 0, exe_scope); + } + if (is_ocaml_array) { return DumpTypeOcamlArray(qual_type, s, data, byte_offset, byte_size, exe_scope, array_element_type);