179caf69cSpeter klausler //===-- runtime/type-info.cpp ---------------------------------------------===// 279caf69cSpeter klausler // 379caf69cSpeter klausler // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 479caf69cSpeter klausler // See https://llvm.org/LICENSE.txt for license information. 579caf69cSpeter klausler // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 679caf69cSpeter klausler // 779caf69cSpeter klausler //===----------------------------------------------------------------------===// 879caf69cSpeter klausler 979caf69cSpeter klausler #include "type-info.h" 1079caf69cSpeter klausler #include "terminator.h" 118b953fddSSlava Zakharin #include "tools.h" 1279caf69cSpeter klausler #include <cstdio> 1379caf69cSpeter klausler 1479caf69cSpeter klausler namespace Fortran::runtime::typeInfo { 1579caf69cSpeter klausler 168b953fddSSlava Zakharin RT_OFFLOAD_API_GROUP_BEGIN 178b953fddSSlava Zakharin 1871e0261fSSlava Zakharin RT_API_ATTRS Fortran::common::optional<TypeParameterValue> Value::GetValue( 1979caf69cSpeter klausler const Descriptor *descriptor) const { 2079caf69cSpeter klausler switch (genre_) { 2179caf69cSpeter klausler case Genre::Explicit: 2279caf69cSpeter klausler return value_; 2379caf69cSpeter klausler case Genre::LenParameter: 2479caf69cSpeter klausler if (descriptor) { 2579caf69cSpeter klausler if (const auto *addendum{descriptor->Addendum()}) { 2679caf69cSpeter klausler return addendum->LenParameterValue(value_); 2779caf69cSpeter klausler } 2879caf69cSpeter klausler } 2971e0261fSSlava Zakharin return Fortran::common::nullopt; 3079caf69cSpeter klausler default: 3171e0261fSSlava Zakharin return Fortran::common::nullopt; 3279caf69cSpeter klausler } 3379caf69cSpeter klausler } 3479caf69cSpeter klausler 358b953fddSSlava Zakharin RT_API_ATTRS std::size_t Component::GetElementByteSize( 368b953fddSSlava Zakharin const Descriptor &instance) const { 37a48e4168Speter klausler switch (category()) { 38a48e4168Speter klausler case TypeCategory::Integer: 39*fc97d2e6SPeter Klausler case TypeCategory::Unsigned: 40a48e4168Speter klausler case TypeCategory::Real: 41a48e4168Speter klausler case TypeCategory::Logical: 42a48e4168Speter klausler return kind_; 43a48e4168Speter klausler case TypeCategory::Complex: 44a48e4168Speter klausler return 2 * kind_; 45a48e4168Speter klausler case TypeCategory::Character: 46a48e4168Speter klausler if (auto value{characterLen_.GetValue(&instance)}) { 47a48e4168Speter klausler return kind_ * *value; 48a48e4168Speter klausler } 49a48e4168Speter klausler break; 50a48e4168Speter klausler case TypeCategory::Derived: 51a48e4168Speter klausler if (const auto *type{derivedType()}) { 52a48e4168Speter klausler return type->sizeInBytes(); 53a48e4168Speter klausler } 54a48e4168Speter klausler break; 55a48e4168Speter klausler } 56a48e4168Speter klausler return 0; 57a48e4168Speter klausler } 58a48e4168Speter klausler 598b953fddSSlava Zakharin RT_API_ATTRS std::size_t Component::GetElements( 608b953fddSSlava Zakharin const Descriptor &instance) const { 61a48e4168Speter klausler std::size_t elements{1}; 62a48e4168Speter klausler if (int rank{rank_}) { 63a48e4168Speter klausler if (const Value * boundValues{bounds()}) { 64a48e4168Speter klausler for (int j{0}; j < rank; ++j) { 65a48e4168Speter klausler TypeParameterValue lb{ 66a48e4168Speter klausler boundValues[2 * j].GetValue(&instance).value_or(0)}; 67a48e4168Speter klausler TypeParameterValue ub{ 68a48e4168Speter klausler boundValues[2 * j + 1].GetValue(&instance).value_or(0)}; 69a48e4168Speter klausler if (ub >= lb) { 70a48e4168Speter klausler elements *= ub - lb + 1; 71a48e4168Speter klausler } else { 72a48e4168Speter klausler return 0; 73a48e4168Speter klausler } 74a48e4168Speter klausler } 75a48e4168Speter klausler } else { 76a48e4168Speter klausler return 0; 77a48e4168Speter klausler } 78a48e4168Speter klausler } 79a48e4168Speter klausler return elements; 80a48e4168Speter klausler } 81a48e4168Speter klausler 828b953fddSSlava Zakharin RT_API_ATTRS std::size_t Component::SizeInBytes( 838b953fddSSlava Zakharin const Descriptor &instance) const { 84a48e4168Speter klausler if (genre() == Genre::Data) { 85a48e4168Speter klausler return GetElementByteSize(instance) * GetElements(instance); 86a48e4168Speter klausler } else if (category() == TypeCategory::Derived) { 87a48e4168Speter klausler const DerivedType *type{derivedType()}; 88a48e4168Speter klausler return Descriptor::SizeInBytes( 89a48e4168Speter klausler rank_, true, type ? type->LenParameters() : 0); 90a48e4168Speter klausler } else { 91a48e4168Speter klausler return Descriptor::SizeInBytes(rank_); 92a48e4168Speter klausler } 93a48e4168Speter klausler } 94a48e4168Speter klausler 958b953fddSSlava Zakharin RT_API_ATTRS void Component::EstablishDescriptor(Descriptor &descriptor, 96a48e4168Speter klausler const Descriptor &container, Terminator &terminator) const { 9782cb7920SPeter Klausler ISO::CFI_attribute_t attribute{static_cast<ISO::CFI_attribute_t>( 9882cb7920SPeter Klausler genre_ == Genre::Allocatable ? CFI_attribute_allocatable 9982cb7920SPeter Klausler : genre_ == Genre::Pointer ? CFI_attribute_pointer 10082cb7920SPeter Klausler : CFI_attribute_other)}; 10179caf69cSpeter klausler TypeCategory cat{category()}; 10279caf69cSpeter klausler if (cat == TypeCategory::Character) { 10307b9a445SPeter Klausler std::size_t lengthInChars{0}; 10407b9a445SPeter Klausler if (auto length{characterLen_.GetValue(&container)}) { 105e141e719SPeter Klausler lengthInChars = static_cast<std::size_t>(*length); 10607b9a445SPeter Klausler } else { 10707b9a445SPeter Klausler RUNTIME_CHECK( 10807b9a445SPeter Klausler terminator, characterLen_.genre() == Value::Genre::Deferred); 10907b9a445SPeter Klausler } 11082cb7920SPeter Klausler descriptor.Establish( 11182cb7920SPeter Klausler kind_, lengthInChars, nullptr, rank_, nullptr, attribute); 11279caf69cSpeter klausler } else if (cat == TypeCategory::Derived) { 11382cb7920SPeter Klausler if (const DerivedType * type{derivedType()}) { 11482cb7920SPeter Klausler descriptor.Establish(*type, nullptr, rank_, nullptr, attribute); 11582cb7920SPeter Klausler } else { // unlimited polymorphic 11682cb7920SPeter Klausler descriptor.Establish(TypeCode{TypeCategory::Derived, 0}, 0, nullptr, 11782cb7920SPeter Klausler rank_, nullptr, attribute, true); 11882cb7920SPeter Klausler } 11979caf69cSpeter klausler } else { 12082cb7920SPeter Klausler descriptor.Establish(cat, kind_, nullptr, rank_, nullptr, attribute); 12179caf69cSpeter klausler } 12227cf6ba1SPeter Klausler if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer) { 12379caf69cSpeter klausler const typeInfo::Value *boundValues{bounds()}; 12479caf69cSpeter klausler RUNTIME_CHECK(terminator, boundValues != nullptr); 12579caf69cSpeter klausler auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())}; 12679caf69cSpeter klausler for (int j{0}; j < rank_; ++j) { 12779caf69cSpeter klausler auto lb{boundValues++->GetValue(&container)}; 12879caf69cSpeter klausler auto ub{boundValues++->GetValue(&container)}; 12979caf69cSpeter klausler RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value()); 13079caf69cSpeter klausler Dimension &dim{descriptor.GetDimension(j)}; 13179caf69cSpeter klausler dim.SetBounds(*lb, *ub); 13279caf69cSpeter klausler dim.SetByteStride(byteStride); 13379caf69cSpeter klausler byteStride *= dim.Extent(); 13479caf69cSpeter klausler } 13579caf69cSpeter klausler } 136a48e4168Speter klausler } 137a48e4168Speter klausler 138050f785eSPhilip Reames RT_API_ATTRS void Component::CreatePointerDescriptor(Descriptor &descriptor, 1396d44387eSpeter klausler const Descriptor &container, Terminator &terminator, 1406d44387eSpeter klausler const SubscriptValue *subscripts) const { 141a48e4168Speter klausler RUNTIME_CHECK(terminator, genre_ == Genre::Data); 142a48e4168Speter klausler EstablishDescriptor(descriptor, container, terminator); 1436d44387eSpeter klausler if (subscripts) { 14479caf69cSpeter klausler descriptor.set_base_addr(container.Element<char>(subscripts) + offset_); 1456d44387eSpeter klausler } else { 1466d44387eSpeter klausler descriptor.set_base_addr(container.OffsetElement<char>() + offset_); 1476d44387eSpeter klausler } 148050f785eSPhilip Reames descriptor.raw().attribute = CFI_attribute_pointer; 149a48e4168Speter klausler } 150a48e4168Speter klausler 1518b953fddSSlava Zakharin RT_API_ATTRS const DerivedType *DerivedType::GetParentType() const { 152a48e4168Speter klausler if (hasParent_) { 153a48e4168Speter klausler const Descriptor &compDesc{component()}; 154a48e4168Speter klausler const Component &component{*compDesc.OffsetElement<const Component>()}; 155a48e4168Speter klausler return component.derivedType(); 156a48e4168Speter klausler } else { 157a48e4168Speter klausler return nullptr; 158a48e4168Speter klausler } 15979caf69cSpeter klausler } 16079caf69cSpeter klausler 1618b953fddSSlava Zakharin RT_API_ATTRS const Component *DerivedType::FindDataComponent( 16279caf69cSpeter klausler const char *compName, std::size_t compNameLen) const { 16379caf69cSpeter klausler const Descriptor &compDesc{component()}; 16479caf69cSpeter klausler std::size_t n{compDesc.Elements()}; 16579caf69cSpeter klausler SubscriptValue at[maxRank]; 16679caf69cSpeter klausler compDesc.GetLowerBounds(at); 16779caf69cSpeter klausler for (std::size_t j{0}; j < n; ++j, compDesc.IncrementSubscripts(at)) { 16879caf69cSpeter klausler const Component *component{compDesc.Element<Component>(at)}; 16979caf69cSpeter klausler INTERNAL_CHECK(component != nullptr); 17079caf69cSpeter klausler const Descriptor &nameDesc{component->name()}; 17179caf69cSpeter klausler if (nameDesc.ElementBytes() == compNameLen && 1728b953fddSSlava Zakharin Fortran::runtime::memcmp( 1738b953fddSSlava Zakharin compName, nameDesc.OffsetElement(), compNameLen) == 0) { 17479caf69cSpeter klausler return component; 17579caf69cSpeter klausler } 17679caf69cSpeter klausler } 177a48e4168Speter klausler const DerivedType *parent{GetParentType()}; 178a48e4168Speter klausler return parent ? parent->FindDataComponent(compName, compNameLen) : nullptr; 17979caf69cSpeter klausler } 18079caf69cSpeter klausler 1818b953fddSSlava Zakharin RT_OFFLOAD_API_GROUP_END 1828b953fddSSlava Zakharin 18379caf69cSpeter klausler static void DumpScalarCharacter( 18479caf69cSpeter klausler FILE *f, const Descriptor &desc, const char *what) { 18579caf69cSpeter klausler if (desc.raw().version == CFI_VERSION && 18679caf69cSpeter klausler desc.type() == TypeCode{TypeCategory::Character, 1} && 18779caf69cSpeter klausler desc.ElementBytes() > 0 && desc.rank() == 0 && 18879caf69cSpeter klausler desc.OffsetElement() != nullptr) { 18979caf69cSpeter klausler std::fwrite(desc.OffsetElement(), desc.ElementBytes(), 1, f); 19079caf69cSpeter klausler } else { 19179caf69cSpeter klausler std::fprintf(f, "bad %s descriptor: ", what); 19279caf69cSpeter klausler desc.Dump(f); 19379caf69cSpeter klausler } 19479caf69cSpeter klausler } 19579caf69cSpeter klausler 19679caf69cSpeter klausler FILE *DerivedType::Dump(FILE *f) const { 1976d44387eSpeter klausler std::fprintf(f, "DerivedType @ %p:\n", reinterpret_cast<const void *>(this)); 19879caf69cSpeter klausler const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)}; 19979caf69cSpeter klausler for (int j{0}; j < 64; ++j) { 20079caf69cSpeter klausler int offset{j * static_cast<int>(sizeof *uints)}; 2016d44387eSpeter klausler std::fprintf(f, " [+%3d](%p) 0x%016jx", offset, 20279caf69cSpeter klausler reinterpret_cast<const void *>(&uints[j]), 20343fadefbSpeter klausler static_cast<std::uintmax_t>(uints[j])); 20479caf69cSpeter klausler if (offset == offsetof(DerivedType, binding_)) { 20579caf69cSpeter klausler std::fputs(" <-- binding_\n", f); 20679caf69cSpeter klausler } else if (offset == offsetof(DerivedType, name_)) { 20779caf69cSpeter klausler std::fputs(" <-- name_\n", f); 20879caf69cSpeter klausler } else if (offset == offsetof(DerivedType, sizeInBytes_)) { 20979caf69cSpeter klausler std::fputs(" <-- sizeInBytes_\n", f); 21079caf69cSpeter klausler } else if (offset == offsetof(DerivedType, uninstantiated_)) { 21179caf69cSpeter klausler std::fputs(" <-- uninstantiated_\n", f); 21279caf69cSpeter klausler } else if (offset == offsetof(DerivedType, kindParameter_)) { 21379caf69cSpeter klausler std::fputs(" <-- kindParameter_\n", f); 21479caf69cSpeter klausler } else if (offset == offsetof(DerivedType, lenParameterKind_)) { 21579caf69cSpeter klausler std::fputs(" <-- lenParameterKind_\n", f); 21679caf69cSpeter klausler } else if (offset == offsetof(DerivedType, component_)) { 21779caf69cSpeter klausler std::fputs(" <-- component_\n", f); 21879caf69cSpeter klausler } else if (offset == offsetof(DerivedType, procPtr_)) { 21979caf69cSpeter klausler std::fputs(" <-- procPtr_\n", f); 22079caf69cSpeter klausler } else if (offset == offsetof(DerivedType, special_)) { 22179caf69cSpeter klausler std::fputs(" <-- special_\n", f); 22265f52904Speter klausler } else if (offset == offsetof(DerivedType, specialBitSet_)) { 22365f52904Speter klausler std::fputs(" <-- specialBitSet_\n", f); 224a48e4168Speter klausler } else if (offset == offsetof(DerivedType, hasParent_)) { 22565f52904Speter klausler std::fputs(" <-- (flags)\n", f); 22679caf69cSpeter klausler } else { 22779caf69cSpeter klausler std::fputc('\n', f); 22879caf69cSpeter klausler } 22979caf69cSpeter klausler } 23079caf69cSpeter klausler std::fputs(" name: ", f); 23179caf69cSpeter klausler DumpScalarCharacter(f, name(), "DerivedType::name"); 23279caf69cSpeter klausler const Descriptor &bindingDesc{binding()}; 23379caf69cSpeter klausler std::fprintf( 23479caf69cSpeter klausler f, "\n binding descriptor (byteSize 0x%zx): ", binding_.byteSize); 23579caf69cSpeter klausler bindingDesc.Dump(f); 23679caf69cSpeter klausler const Descriptor &compDesc{component()}; 23779caf69cSpeter klausler std::fputs("\n components:\n", f); 23879caf69cSpeter klausler if (compDesc.raw().version == CFI_VERSION && 23979caf69cSpeter klausler compDesc.type() == TypeCode{TypeCategory::Derived, 0} && 24079caf69cSpeter klausler compDesc.ElementBytes() == sizeof(Component) && compDesc.rank() == 1) { 24179caf69cSpeter klausler std::size_t n{compDesc.Elements()}; 24279caf69cSpeter klausler for (std::size_t j{0}; j < n; ++j) { 24379caf69cSpeter klausler const Component &comp{*compDesc.ZeroBasedIndexedElement<Component>(j)}; 24479caf69cSpeter klausler std::fprintf(f, " [%3zd] ", j); 24579caf69cSpeter klausler comp.Dump(f); 24679caf69cSpeter klausler } 24779caf69cSpeter klausler } else { 24879caf69cSpeter klausler std::fputs(" bad descriptor: ", f); 24979caf69cSpeter klausler compDesc.Dump(f); 25079caf69cSpeter klausler } 25143fadefbSpeter klausler const Descriptor &specialDesc{special()}; 25243fadefbSpeter klausler std::fprintf( 25343fadefbSpeter klausler f, "\n special descriptor (byteSize 0x%zx): ", special_.byteSize); 25443fadefbSpeter klausler specialDesc.Dump(f); 255dffd93b3SPeter Klausler if (specialDesc.IsAllocated()) { 25643fadefbSpeter klausler std::size_t specials{specialDesc.Elements()}; 25743fadefbSpeter klausler for (std::size_t j{0}; j < specials; ++j) { 25843fadefbSpeter klausler std::fprintf(f, " [%3zd] ", j); 25943fadefbSpeter klausler specialDesc.ZeroBasedIndexedElement<SpecialBinding>(j)->Dump(f); 26043fadefbSpeter klausler } 261dffd93b3SPeter Klausler } 26279caf69cSpeter klausler return f; 26379caf69cSpeter klausler } 26479caf69cSpeter klausler 26579caf69cSpeter klausler FILE *Component::Dump(FILE *f) const { 2666d44387eSpeter klausler std::fprintf(f, "Component @ %p:\n", reinterpret_cast<const void *>(this)); 26779caf69cSpeter klausler std::fputs(" name: ", f); 26879caf69cSpeter klausler DumpScalarCharacter(f, name(), "Component::name"); 269b3c1f53cSpeter klausler if (genre_ == Genre::Data) { 27079caf69cSpeter klausler std::fputs(" Data ", f); 271b3c1f53cSpeter klausler } else if (genre_ == Genre::Pointer) { 27279caf69cSpeter klausler std::fputs(" Pointer ", f); 273b3c1f53cSpeter klausler } else if (genre_ == Genre::Allocatable) { 27479caf69cSpeter klausler std::fputs(" Allocatable", f); 275b3c1f53cSpeter klausler } else if (genre_ == Genre::Automatic) { 27679caf69cSpeter klausler std::fputs(" Automatic ", f); 277b3c1f53cSpeter klausler } else { 27879caf69cSpeter klausler std::fprintf(f, " (bad genre 0x%x)", static_cast<int>(genre_)); 27979caf69cSpeter klausler } 28079caf69cSpeter klausler std::fprintf(f, " category %d kind %d rank %d offset 0x%zx\n", category_, 28179caf69cSpeter klausler kind_, rank_, static_cast<std::size_t>(offset_)); 282a48e4168Speter klausler if (initialization_) { 2836d44387eSpeter klausler std::fprintf(f, " initialization @ %p:\n", 28413e08de9Speter klausler reinterpret_cast<const void *>(initialization_)); 285a48e4168Speter klausler for (int j{0}; j < 128; j += sizeof(std::uint64_t)) { 286a48e4168Speter klausler std::fprintf(f, " [%3d] 0x%016jx\n", j, 287a48e4168Speter klausler static_cast<std::uintmax_t>( 288a48e4168Speter klausler *reinterpret_cast<const std::uint64_t *>(initialization_ + j))); 289a48e4168Speter klausler } 290a48e4168Speter klausler } 29179caf69cSpeter klausler return f; 29279caf69cSpeter klausler } 29379caf69cSpeter klausler 29443fadefbSpeter klausler FILE *SpecialBinding::Dump(FILE *f) const { 29543fadefbSpeter klausler std::fprintf( 2966d44387eSpeter klausler f, "SpecialBinding @ %p:\n", reinterpret_cast<const void *>(this)); 29743fadefbSpeter klausler switch (which_) { 29865f52904Speter klausler case Which::ScalarAssignment: 29965f52904Speter klausler std::fputs(" ScalarAssignment", f); 30043fadefbSpeter klausler break; 30143fadefbSpeter klausler case Which::ElementalAssignment: 30243fadefbSpeter klausler std::fputs(" ElementalAssignment", f); 30343fadefbSpeter klausler break; 30443fadefbSpeter klausler case Which::ReadFormatted: 30543fadefbSpeter klausler std::fputs(" ReadFormatted", f); 30643fadefbSpeter klausler break; 30743fadefbSpeter klausler case Which::ReadUnformatted: 30843fadefbSpeter klausler std::fputs(" ReadUnformatted", f); 30943fadefbSpeter klausler break; 31043fadefbSpeter klausler case Which::WriteFormatted: 31143fadefbSpeter klausler std::fputs(" WriteFormatted", f); 31243fadefbSpeter klausler break; 31343fadefbSpeter klausler case Which::WriteUnformatted: 31443fadefbSpeter klausler std::fputs(" WriteUnformatted", f); 31543fadefbSpeter klausler break; 31665f52904Speter klausler case Which::ElementalFinal: 31765f52904Speter klausler std::fputs(" ElementalFinal", f); 31865f52904Speter klausler break; 31965f52904Speter klausler case Which::AssumedRankFinal: 32065f52904Speter klausler std::fputs(" AssumedRankFinal", f); 32165f52904Speter klausler break; 32243fadefbSpeter klausler default: 32365f52904Speter klausler std::fprintf(f, " rank-%d final:", 32465f52904Speter klausler static_cast<int>(which_) - static_cast<int>(Which::ScalarFinal)); 32543fadefbSpeter klausler break; 32643fadefbSpeter klausler } 327a48e4168Speter klausler std::fprintf(f, " isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_); 328b21c24c3SPeter Klausler std::fprintf(f, " isTypeBound: 0x%x\n", isTypeBound_); 329b21c24c3SPeter Klausler std::fprintf(f, " isArgContiguousSet: 0x%x\n", isArgContiguousSet_); 3306d44387eSpeter klausler std::fprintf(f, " proc: %p\n", reinterpret_cast<void *>(proc_)); 33143fadefbSpeter klausler return f; 33243fadefbSpeter klausler } 33343fadefbSpeter klausler 33479caf69cSpeter klausler } // namespace Fortran::runtime::typeInfo 335