flang/runtime/type-info.cpp

   1 //===-- runtime/type-info.cpp ---------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "type-info.h"
  10 #include "terminator.h"
  11 #include "tools.h"
  12 #include <cstdio>
  13
  14 namespace Fortran::runtime::typeInfo {
  15
  16 RT_OFFLOAD_API_GROUP_BEGIN
  17
  18 RT_API_ATTRS std::optional<TypeParameterValue> Value::GetValue(
  19     const Descriptor *descriptor) const {
  20   switch (genre_) {
  21   case Genre::Explicit:
  22     return value_;
  23   case Genre::LenParameter:
  24     if (descriptor) {
  25       if (const auto *addendum{descriptor->Addendum()}) {
  26         return addendum->LenParameterValue(value_);
  27       }
  28     }
  29     return std::nullopt;
  30   default:
  31     return std::nullopt;
  32   }
  33 }
  34
  35 RT_API_ATTRS std::size_t Component::GetElementByteSize(
  36     const Descriptor &instance) const {
  37   switch (category()) {
  38   case TypeCategory::Integer:
  39   case TypeCategory::Real:
  40   case TypeCategory::Logical:
  41     return kind_;
  42   case TypeCategory::Complex:
  43     return 2 * kind_;
  44   case TypeCategory::Character:
  45     if (auto value{characterLen_.GetValue(&instance)}) {
  46       return kind_ * *value;
  47     }
  48     break;
  49   case TypeCategory::Derived:
  50     if (const auto *type{derivedType()}) {
  51       return type->sizeInBytes();
  52     }
  53     break;
  54   }
  55   return 0;
  56 }
  57
  58 RT_API_ATTRS std::size_t Component::GetElements(
  59     const Descriptor &instance) const {
  60   std::size_t elements{1};
  61   if (int rank{rank_}) {
  62     if (const Value * boundValues{bounds()}) {
  63       for (int j{0}; j < rank; ++j) {
  64         TypeParameterValue lb{
  65             boundValues[2 * j].GetValue(&instance).value_or(0)};
  66         TypeParameterValue ub{
  67             boundValues[2 * j + 1].GetValue(&instance).value_or(0)};
  68         if (ub >= lb) {
  69           elements *= ub - lb + 1;
  70         } else {
  71           return 0;
  72         }
  73       }
  74     } else {
  75       return 0;
  76     }
  77   }
  78   return elements;
  79 }
  80
  81 RT_API_ATTRS std::size_t Component::SizeInBytes(
  82     const Descriptor &instance) const {
  83   if (genre() == Genre::Data) {
  84     return GetElementByteSize(instance) * GetElements(instance);
  85   } else if (category() == TypeCategory::Derived) {
  86     const DerivedType *type{derivedType()};
  87     return Descriptor::SizeInBytes(
  88         rank_, true, type ? type->LenParameters() : 0);
  89   } else {
  90     return Descriptor::SizeInBytes(rank_);
  91   }
  92 }
  93
  94 RT_API_ATTRS void Component::EstablishDescriptor(Descriptor &descriptor,
  95     const Descriptor &container, Terminator &terminator) const {
  96   ISO::CFI_attribute_t attribute{static_cast<ISO::CFI_attribute_t>(
  97       genre_ == Genre::Allocatable   ? CFI_attribute_allocatable
  98           : genre_ == Genre::Pointer ? CFI_attribute_pointer
  99                                      : CFI_attribute_other)};
 100   TypeCategory cat{category()};
 101   if (cat == TypeCategory::Character) {
 102     std::size_t lengthInChars{0};
 103     if (auto length{characterLen_.GetValue(&container)}) {
 104       lengthInChars = static_cast<std::size_t>(*length);
 105     } else {
 106       RUNTIME_CHECK(
 107           terminator, characterLen_.genre() == Value::Genre::Deferred);
 108     }
 109     descriptor.Establish(
 110         kind_, lengthInChars, nullptr, rank_, nullptr, attribute);
 111   } else if (cat == TypeCategory::Derived) {
 112     if (const DerivedType * type{derivedType()}) {
 113       descriptor.Establish(*type, nullptr, rank_, nullptr, attribute);
 114     } else { // unlimited polymorphic
 115       descriptor.Establish(TypeCode{TypeCategory::Derived, 0}, 0, nullptr,
 116           rank_, nullptr, attribute, true);
 117     }
 118   } else {
 119     descriptor.Establish(cat, kind_, nullptr, rank_, nullptr, attribute);
 120   }
 121   if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer) {
 122     const typeInfo::Value *boundValues{bounds()};
 123     RUNTIME_CHECK(terminator, boundValues != nullptr);
 124     auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
 125     for (int j{0}; j < rank_; ++j) {
 126       auto lb{boundValues++->GetValue(&container)};
 127       auto ub{boundValues++->GetValue(&container)};
 128       RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value());
 129       Dimension &dim{descriptor.GetDimension(j)};
 130       dim.SetBounds(*lb, *ub);
 131       dim.SetByteStride(byteStride);
 132       byteStride *= dim.Extent();
 133     }
 134   }
 135 }
 136
 137 RT_API_ATTRS void Component::CreatePointerDescriptor(Descriptor &descriptor,
 138     const Descriptor &container, Terminator &terminator,
 139     const SubscriptValue *subscripts) const {
 140   RUNTIME_CHECK(terminator, genre_ == Genre::Data);
 141   EstablishDescriptor(descriptor, container, terminator);
 142   if (subscripts) {
 143     descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
 144   } else {
 145     descriptor.set_base_addr(container.OffsetElement<char>() + offset_);
 146   }
 147   descriptor.raw().attribute = CFI_attribute_pointer;
 148 }
 149
 150 RT_API_ATTRS const DerivedType *DerivedType::GetParentType() const {
 151   if (hasParent_) {
 152     const Descriptor &compDesc{component()};
 153     const Component &component{*compDesc.OffsetElement<const Component>()};
 154     return component.derivedType();
 155   } else {
 156     return nullptr;
 157   }
 158 }
 159
 160 RT_API_ATTRS const Component *DerivedType::FindDataComponent(
 161     const char *compName, std::size_t compNameLen) const {
 162   const Descriptor &compDesc{component()};
 163   std::size_t n{compDesc.Elements()};
 164   SubscriptValue at[maxRank];
 165   compDesc.GetLowerBounds(at);
 166   for (std::size_t j{0}; j < n; ++j, compDesc.IncrementSubscripts(at)) {
 167     const Component *component{compDesc.Element<Component>(at)};
 168     INTERNAL_CHECK(component != nullptr);
 169     const Descriptor &nameDesc{component->name()};
 170     if (nameDesc.ElementBytes() == compNameLen &&
 171         Fortran::runtime::memcmp(
 172             compName, nameDesc.OffsetElement(), compNameLen) == 0) {
 173       return component;
 174     }
 175   }
 176   const DerivedType *parent{GetParentType()};
 177   return parent ? parent->FindDataComponent(compName, compNameLen) : nullptr;
 178 }
 179
 180 RT_OFFLOAD_API_GROUP_END
 181
 182 static void DumpScalarCharacter(
 183     FILE *f, const Descriptor &desc, const char *what) {
 184   if (desc.raw().version == CFI_VERSION &&
 185       desc.type() == TypeCode{TypeCategory::Character, 1} &&
 186       desc.ElementBytes() > 0 && desc.rank() == 0 &&
 187       desc.OffsetElement() != nullptr) {
 188     std::fwrite(desc.OffsetElement(), desc.ElementBytes(), 1, f);
 189   } else {
 190     std::fprintf(f, "bad %s descriptor: ", what);
 191     desc.Dump(f);
 192   }
 193 }
 194
 195 FILE *DerivedType::Dump(FILE *f) const {
 196   std::fprintf(f, "DerivedType @ %p:\n", reinterpret_cast<const void *>(this));
 197   const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)};
 198   for (int j{0}; j < 64; ++j) {
 199     int offset{j * static_cast<int>(sizeof *uints)};
 200     std::fprintf(f, "    [+%3d](%p) 0x%016jx", offset,
 201         reinterpret_cast<const void *>(&uints[j]),
 202         static_cast<std::uintmax_t>(uints[j]));
 203     if (offset == offsetof(DerivedType, binding_)) {
 204       std::fputs(" <-- binding_\n", f);
 205     } else if (offset == offsetof(DerivedType, name_)) {
 206       std::fputs(" <-- name_\n", f);
 207     } else if (offset == offsetof(DerivedType, sizeInBytes_)) {
 208       std::fputs(" <-- sizeInBytes_\n", f);
 209     } else if (offset == offsetof(DerivedType, uninstantiated_)) {
 210       std::fputs(" <-- uninstantiated_\n", f);
 211     } else if (offset == offsetof(DerivedType, kindParameter_)) {
 212       std::fputs(" <-- kindParameter_\n", f);
 213     } else if (offset == offsetof(DerivedType, lenParameterKind_)) {
 214       std::fputs(" <-- lenParameterKind_\n", f);
 215     } else if (offset == offsetof(DerivedType, component_)) {
 216       std::fputs(" <-- component_\n", f);
 217     } else if (offset == offsetof(DerivedType, procPtr_)) {
 218       std::fputs(" <-- procPtr_\n", f);
 219     } else if (offset == offsetof(DerivedType, special_)) {
 220       std::fputs(" <-- special_\n", f);
 221     } else if (offset == offsetof(DerivedType, specialBitSet_)) {
 222       std::fputs(" <-- specialBitSet_\n", f);
 223     } else if (offset == offsetof(DerivedType, hasParent_)) {
 224       std::fputs(" <-- (flags)\n", f);
 225     } else {
 226       std::fputc('\n', f);
 227     }
 228   }
 229   std::fputs("  name: ", f);
 230   DumpScalarCharacter(f, name(), "DerivedType::name");
 231   const Descriptor &bindingDesc{binding()};
 232   std::fprintf(
 233       f, "\n  binding descriptor (byteSize 0x%zx): ", binding_.byteSize);
 234   bindingDesc.Dump(f);
 235   const Descriptor &compDesc{component()};
 236   std::fputs("\n  components:\n", f);
 237   if (compDesc.raw().version == CFI_VERSION &&
 238       compDesc.type() == TypeCode{TypeCategory::Derived, 0} &&
 239       compDesc.ElementBytes() == sizeof(Component) && compDesc.rank() == 1) {
 240     std::size_t n{compDesc.Elements()};
 241     for (std::size_t j{0}; j < n; ++j) {
 242       const Component &comp{*compDesc.ZeroBasedIndexedElement<Component>(j)};
 243       std::fprintf(f, "  [%3zd] ", j);
 244       comp.Dump(f);
 245     }
 246   } else {
 247     std::fputs("    bad descriptor: ", f);
 248     compDesc.Dump(f);
 249   }
 250   const Descriptor &specialDesc{special()};
 251   std::fprintf(
 252       f, "\n  special descriptor (byteSize 0x%zx): ", special_.byteSize);
 253   specialDesc.Dump(f);
 254   if (specialDesc.IsAllocated()) {
 255     std::size_t specials{specialDesc.Elements()};
 256     for (std::size_t j{0}; j < specials; ++j) {
 257       std::fprintf(f, "  [%3zd] ", j);
 258       specialDesc.ZeroBasedIndexedElement<SpecialBinding>(j)->Dump(f);
 259     }
 260   }
 261   return f;
 262 }
 263
 264 FILE *Component::Dump(FILE *f) const {
 265   std::fprintf(f, "Component @ %p:\n", reinterpret_cast<const void *>(this));
 266   std::fputs("    name: ", f);
 267   DumpScalarCharacter(f, name(), "Component::name");
 268   if (genre_ == Genre::Data) {
 269     std::fputs("    Data       ", f);
 270   } else if (genre_ == Genre::Pointer) {
 271     std::fputs("    Pointer    ", f);
 272   } else if (genre_ == Genre::Allocatable) {
 273     std::fputs("    Allocatable", f);
 274   } else if (genre_ == Genre::Automatic) {
 275     std::fputs("    Automatic  ", f);
 276   } else {
 277     std::fprintf(f, "    (bad genre 0x%x)", static_cast<int>(genre_));
 278   }
 279   std::fprintf(f, " category %d  kind %d  rank %d  offset 0x%zx\n", category_,
 280       kind_, rank_, static_cast<std::size_t>(offset_));
 281   if (initialization_) {
 282     std::fprintf(f, " initialization @ %p:\n",
 283         reinterpret_cast<const void *>(initialization_));
 284     for (int j{0}; j < 128; j += sizeof(std::uint64_t)) {
 285       std::fprintf(f, " [%3d] 0x%016jx\n", j,
 286           static_cast<std::uintmax_t>(
 287               *reinterpret_cast<const std::uint64_t *>(initialization_ + j)));
 288     }
 289   }
 290   return f;
 291 }
 292
 293 FILE *SpecialBinding::Dump(FILE *f) const {
 294   std::fprintf(
 295       f, "SpecialBinding @ %p:\n", reinterpret_cast<const void *>(this));
 296   switch (which_) {
 297   case Which::ScalarAssignment:
 298     std::fputs("    ScalarAssignment", f);
 299     break;
 300   case Which::ElementalAssignment:
 301     std::fputs("    ElementalAssignment", f);
 302     break;
 303   case Which::ReadFormatted:
 304     std::fputs("    ReadFormatted", f);
 305     break;
 306   case Which::ReadUnformatted:
 307     std::fputs("    ReadUnformatted", f);
 308     break;
 309   case Which::WriteFormatted:
 310     std::fputs("    WriteFormatted", f);
 311     break;
 312   case Which::WriteUnformatted:
 313     std::fputs("    WriteUnformatted", f);
 314     break;
 315   case Which::ElementalFinal:
 316     std::fputs("    ElementalFinal", f);
 317     break;
 318   case Which::AssumedRankFinal:
 319     std::fputs("    AssumedRankFinal", f);
 320     break;
 321   default:
 322     std::fprintf(f, "    rank-%d final:",
 323         static_cast<int>(which_) - static_cast<int>(Which::ScalarFinal));
 324     break;
 325   }
 326   std::fprintf(f, "    isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_);
 327   std::fprintf(f, "    isTypeBound: 0x%x\n", isTypeBound_);
 328   std::fprintf(f, "    isArgContiguousSet: 0x%x\n", isArgContiguousSet_);
 329   std::fprintf(f, "    proc: %p\n", reinterpret_cast<void *>(proc_));
 330   return f;
 331 }
 332
 333 } // namespace Fortran::runtime::typeInfo