xref: /llvm-project/flang/runtime/type-info.cpp (revision fc97d2e68b03bc2979395e84b645e5b3ba35aecd)
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