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