352 lines · cpp
1//===-- lib/runtime/type-info.cpp -------------------------------*- C++ -*-===//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-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang-rt/runtime/type-info.h"10#include "flang-rt/runtime/terminator.h"11#include "flang-rt/runtime/tools.h"12#include <cstdio>13 14namespace Fortran::runtime::typeInfo {15 16RT_OFFLOAD_API_GROUP_BEGIN17 18RT_API_ATTRS 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 common::nullopt;30 default:31 return common::nullopt;32 }33}34 35RT_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 59RT_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 82RT_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 95RT_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 || genre_ == Genre::AllocatableDevice99 ? CFI_attribute_allocatable100 : genre_ == Genre::Pointer || genre_ == Genre::PointerDevice101 ? CFI_attribute_pointer102 : CFI_attribute_other)};103 TypeCategory cat{category()};104 unsigned allocatorIdx{105 genre_ == Genre::AllocatableDevice || genre_ == Genre::PointerDevice106 ? kDeviceAllocatorPos107 : kDefaultAllocator};108 if (cat == TypeCategory::Character) {109 std::size_t lengthInChars{0};110 if (auto length{characterLen_.GetValue(&container)}) {111 lengthInChars = static_cast<std::size_t>(*length);112 } else {113 RUNTIME_CHECK(114 terminator, characterLen_.genre() == Value::Genre::Deferred);115 }116 descriptor.Establish(kind_, lengthInChars, nullptr, rank_, nullptr,117 attribute, false, allocatorIdx);118 } else if (cat == TypeCategory::Derived) {119 if (const DerivedType * type{derivedType()}) {120 descriptor.Establish(121 *type, nullptr, rank_, nullptr, attribute, allocatorIdx);122 } else { // unlimited polymorphic123 descriptor.Establish(TypeCode{TypeCategory::Derived, 0}, 0, nullptr,124 rank_, nullptr, attribute, true, allocatorIdx);125 }126 } else {127 descriptor.Establish(128 cat, kind_, nullptr, rank_, nullptr, attribute, false, allocatorIdx);129 }130 if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer &&131 genre_ != Genre::AllocatableDevice && genre_ != Genre::PointerDevice) {132 const typeInfo::Value *boundValues{bounds()};133 RUNTIME_CHECK(terminator, boundValues != nullptr);134 auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};135 for (int j{0}; j < rank_; ++j) {136 auto lb{boundValues++->GetValue(&container)};137 auto ub{boundValues++->GetValue(&container)};138 RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value());139 Dimension &dim{descriptor.GetDimension(j)};140 dim.SetBounds(*lb, *ub);141 dim.SetByteStride(byteStride);142 byteStride *= dim.Extent();143 }144 }145}146 147RT_API_ATTRS void Component::CreatePointerDescriptor(Descriptor &descriptor,148 const Descriptor &container, Terminator &terminator,149 const SubscriptValue *subscripts) const {150 RUNTIME_CHECK(terminator, genre_ == Genre::Data);151 EstablishDescriptor(descriptor, container, terminator);152 std::size_t offset{static_cast<std::size_t>(offset_)};153 if (subscripts) {154 offset += container.SubscriptsToByteOffset(subscripts);155 }156 descriptor.set_base_addr(container.OffsetElement<char>() + offset);157 descriptor.raw().attribute = CFI_attribute_pointer;158}159 160RT_API_ATTRS const DerivedType *DerivedType::GetParentType() const {161 if (hasParent_) {162 const Descriptor &compDesc{component()};163 const Component &component{*compDesc.OffsetElement<const Component>()};164 return component.derivedType();165 } else {166 return nullptr;167 }168}169 170RT_API_ATTRS const Component *DerivedType::FindDataComponent(171 const char *compName, std::size_t compNameLen) const {172 const Descriptor &compDesc{component()};173 std::size_t n{compDesc.Elements()};174 SubscriptValue at[maxRank];175 compDesc.GetLowerBounds(at);176 for (std::size_t j{0}; j < n; ++j, compDesc.IncrementSubscripts(at)) {177 const Component *component{compDesc.Element<Component>(at)};178 INTERNAL_CHECK(component != nullptr);179 const Descriptor &nameDesc{component->name()};180 if (nameDesc.ElementBytes() == compNameLen &&181 Fortran::runtime::memcmp(182 compName, nameDesc.OffsetElement(), compNameLen) == 0) {183 return component;184 }185 }186 const DerivedType *parent{GetParentType()};187 return parent ? parent->FindDataComponent(compName, compNameLen) : nullptr;188}189 190RT_OFFLOAD_API_GROUP_END191 192static void DumpScalarCharacter(193 FILE *f, const Descriptor &desc, const char *what) {194 if (desc.raw().version == CFI_VERSION &&195 desc.type() == TypeCode{TypeCategory::Character, 1} &&196 desc.ElementBytes() > 0 && desc.rank() == 0 &&197 desc.OffsetElement() != nullptr) {198 std::fwrite(desc.OffsetElement(), desc.ElementBytes(), 1, f);199 } else {200 std::fprintf(f, "bad %s descriptor: ", what);201 desc.Dump(f);202 }203}204 205FILE *DerivedType::Dump(FILE *f) const {206 std::fprintf(f, "DerivedType @ %p:\n", reinterpret_cast<const void *>(this));207 const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)};208 for (int j{0}; j < 64; ++j) {209 int offset{j * static_cast<int>(sizeof *uints)};210 std::fprintf(f, " [+%3d](%p) 0x%016jx", offset,211 reinterpret_cast<const void *>(&uints[j]),212 static_cast<std::uintmax_t>(uints[j]));213 if (offset == offsetof(DerivedType, binding_)) {214 std::fputs(" <-- binding_\n", f);215 } else if (offset == offsetof(DerivedType, name_)) {216 std::fputs(" <-- name_\n", f);217 } else if (offset == offsetof(DerivedType, sizeInBytes_)) {218 std::fputs(" <-- sizeInBytes_\n", f);219 } else if (offset == offsetof(DerivedType, uninstantiated_)) {220 std::fputs(" <-- uninstantiated_\n", f);221 } else if (offset == offsetof(DerivedType, kindParameter_)) {222 std::fputs(" <-- kindParameter_\n", f);223 } else if (offset == offsetof(DerivedType, lenParameterKind_)) {224 std::fputs(" <-- lenParameterKind_\n", f);225 } else if (offset == offsetof(DerivedType, component_)) {226 std::fputs(" <-- component_\n", f);227 } else if (offset == offsetof(DerivedType, procPtr_)) {228 std::fputs(" <-- procPtr_\n", f);229 } else if (offset == offsetof(DerivedType, special_)) {230 std::fputs(" <-- special_\n", f);231 } else if (offset == offsetof(DerivedType, specialBitSet_)) {232 std::fputs(" <-- specialBitSet_\n", f);233 } else if (offset == offsetof(DerivedType, hasParent_)) {234 std::fputs(" <-- (flags)\n", f);235 } else {236 std::fputc('\n', f);237 }238 }239 std::fputs(" name: ", f);240 DumpScalarCharacter(f, name(), "DerivedType::name");241 const Descriptor &bindingDesc{binding()};242 std::fprintf(243 f, "\n binding descriptor (byteSize 0x%zx): ", binding_.byteSize);244 bindingDesc.Dump(f);245 const Descriptor &compDesc{component()};246 std::fputs("\n components:\n", f);247 if (compDesc.raw().version == CFI_VERSION &&248 compDesc.type() == TypeCode{TypeCategory::Derived, 0} &&249 compDesc.ElementBytes() == sizeof(Component) && compDesc.rank() == 1) {250 std::size_t n{compDesc.Elements()};251 for (std::size_t j{0}; j < n; ++j) {252 const Component &comp{*compDesc.ZeroBasedIndexedElement<Component>(j)};253 std::fprintf(f, " [%3zd] ", j);254 comp.Dump(f);255 }256 } else {257 std::fputs(" bad descriptor: ", f);258 compDesc.Dump(f);259 }260 const Descriptor &specialDesc{special()};261 std::fprintf(262 f, "\n special descriptor (byteSize 0x%zx): ", special_.byteSize);263 specialDesc.Dump(f);264 if (specialDesc.IsAllocated()) {265 std::size_t specials{specialDesc.Elements()};266 for (std::size_t j{0}; j < specials; ++j) {267 std::fprintf(f, " [%3zd] ", j);268 specialDesc.ZeroBasedIndexedElement<SpecialBinding>(j)->Dump(f);269 }270 }271 return f;272}273 274FILE *Component::Dump(FILE *f) const {275 std::fprintf(f, "Component @ %p:\n", reinterpret_cast<const void *>(this));276 std::fputs(" name: ", f);277 DumpScalarCharacter(f, name(), "Component::name");278 if (genre_ == Genre::Data) {279 std::fputs(" Data ", f);280 } else if (genre_ == Genre::Pointer) {281 std::fputs(" Pointer ", f);282 } else if (genre_ == Genre::PointerDevice) {283 std::fputs(" PointerDevice ", f);284 } else if (genre_ == Genre::Allocatable) {285 std::fputs(" Allocatable. ", f);286 } else if (genre_ == Genre::AllocatableDevice) {287 std::fputs(" AllocatableDevice", f);288 } else if (genre_ == Genre::Automatic) {289 std::fputs(" Automatic ", f);290 } else {291 std::fprintf(f, " (bad genre 0x%x)", static_cast<int>(genre_));292 }293 std::fprintf(f, " category %d kind %d rank %d offset 0x%zx\n", category_,294 kind_, rank_, static_cast<std::size_t>(offset_));295 const auto &dtDesc{derivedType_.descriptor()};296 if (dtDesc.raw().base_addr) {297 std::fprintf(f, " derivedType_ %p\n", dtDesc.raw().base_addr);298 }299 if (initialization_) {300 std::fprintf(f, " initialization @ %p:\n",301 reinterpret_cast<const void *>(initialization_));302 for (int j{0}; j < 128; j += sizeof(std::uint64_t)) {303 std::fprintf(f, " [%3d] 0x%016jx\n", j,304 static_cast<std::uintmax_t>(305 *reinterpret_cast<const std::uint64_t *>(initialization_ + j)));306 }307 }308 return f;309}310 311FILE *SpecialBinding::Dump(FILE *f) const {312 std::fprintf(313 f, "SpecialBinding @ %p:\n", reinterpret_cast<const void *>(this));314 switch (which_) {315 case Which::ScalarAssignment:316 std::fputs(" ScalarAssignment", f);317 break;318 case Which::ElementalAssignment:319 std::fputs(" ElementalAssignment", f);320 break;321 case Which::ReadFormatted:322 std::fputs(" ReadFormatted", f);323 break;324 case Which::ReadUnformatted:325 std::fputs(" ReadUnformatted", f);326 break;327 case Which::WriteFormatted:328 std::fputs(" WriteFormatted", f);329 break;330 case Which::WriteUnformatted:331 std::fputs(" WriteUnformatted", f);332 break;333 case Which::ElementalFinal:334 std::fputs(" ElementalFinal", f);335 break;336 case Which::AssumedRankFinal:337 std::fputs(" AssumedRankFinal", f);338 break;339 default:340 std::fprintf(f, " rank-%d final:",341 static_cast<int>(which_) - static_cast<int>(Which::ScalarFinal));342 break;343 }344 std::fprintf(f, " isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_);345 std::fprintf(f, " isTypeBound: %d\n", isTypeBound_);346 std::fprintf(f, " specialCaseFlag 0x%x\n", specialCaseFlag_);347 std::fprintf(f, " proc: %p\n", reinterpret_cast<void *>(proc_));348 return f;349}350 351} // namespace Fortran::runtime::typeInfo352