RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(SemanticsContext &);
-void Dump(llvm::raw_ostream &, const RuntimeDerivedTypeTables &);
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_RUNTIME_TYPE_INFO_H_
scope, SaveObjectName(".lpk."s + distinctName), std::move(lenKinds)));
// Traverse the components of the derived type
if (!isPDTdefinition) {
- std::vector<evaluate::StructureConstructor> dataComponents;
+ std::vector<const Symbol *> dataComponentSymbols;
std::vector<evaluate::StructureConstructor> procPtrComponents;
std::vector<evaluate::StructureConstructor> specials;
for (const auto &pair : dtScope) {
[&](const TypeParamDetails &) {
// already handled above in declaration order
},
- [&](const ObjectEntityDetails &object) {
- dataComponents.emplace_back(DescribeComponent(
- symbol, object, scope, dtScope, distinctName, parameters));
+ [&](const ObjectEntityDetails &) {
+ dataComponentSymbols.push_back(&symbol);
},
[&](const ProcEntityDetails &proc) {
if (IsProcedurePointer(symbol)) {
},
symbol.details());
}
+ // Sort the data component symbols by offset before emitting them
+ std::sort(dataComponentSymbols.begin(), dataComponentSymbols.end(),
+ [](const Symbol *x, const Symbol *y) {
+ return x->offset() < y->offset();
+ });
+ std::vector<evaluate::StructureConstructor> dataComponents;
+ for (const Symbol *symbol : dataComponentSymbols) {
+ auto locationRestorer{common::ScopedSet(location_, symbol->name())};
+ dataComponents.emplace_back(
+ DescribeComponent(*symbol, symbol->get<ObjectEntityDetails>(), scope,
+ dtScope, distinctName, parameters));
+ }
AddValue(dtValues, derivedTypeSchema_, "component"s,
SaveDerivedPointerTarget(scope, SaveObjectName(".c."s + distinctName),
std::move(dataComponents),
tools.cpp
transformational.cpp
type-code.cpp
+ type-info.cpp
unit.cpp
unit-map.cpp
if (const auto *derived{addendum->derivedType()}) {
RUNTIME_CHECK(terminator,
from.Addendum() && derived == from.Addendum()->derivedType());
- const Descriptor &componentDesc{derived->component.descriptor()};
+ const Descriptor &componentDesc{derived->component()};
const typeInfo::Component *component{
componentDesc.OffsetElement<typeInfo::Component>()};
std::size_t nComponents{componentDesc.Elements()};
for (std::size_t j{0}; j < nComponents; ++j, ++component) {
- if (component->genre == typeInfo::Component::Genre::Allocatable ||
- component->genre == typeInfo::Component::Genre::Automatic) {
+ if (component->genre() == typeInfo::Component::Genre::Allocatable ||
+ component->genre() == typeInfo::Component::Genre::Automatic) {
Descriptor &toDesc{
- *reinterpret_cast<Descriptor *>(toPtr + component->offset)};
+ *reinterpret_cast<Descriptor *>(toPtr + component->offset())};
if (toDesc.raw().base_addr != nullptr) {
toDesc.set_base_addr(nullptr);
RUNTIME_CHECK(terminator, toDesc.Allocate() == CFI_SUCCESS);
const Descriptor &fromDesc{*reinterpret_cast<const Descriptor *>(
- fromPtr + component->offset)};
+ fromPtr + component->offset())};
CopyArray(toDesc, fromDesc, terminator);
}
}
static const typeInfo::SpecialBinding *FindFinal(
const typeInfo::DerivedType &derived, int rank) {
const typeInfo::SpecialBinding *elemental{nullptr};
- const Descriptor &specialDesc{derived.special.descriptor()};
+ const Descriptor &specialDesc{derived.special()};
std::size_t totalSpecialBindings{specialDesc.Elements()};
for (std::size_t j{0}; j < totalSpecialBindings; ++j) {
const auto &special{
}
}
-static inline SubscriptValue GetValue(
- const typeInfo::Value &value, const Descriptor &descriptor) {
- if (value.genre == typeInfo::Value::Genre::LenParameter) {
- return descriptor.Addendum()->LenParameterValue(value.value);
- } else {
- return value.value;
- }
-}
-
// The order of finalization follows Fortran 2018 7.5.6.2, with
// deallocation of non-parent components (and their consequent finalization)
// taking place before parent component finalization.
if (finalize) {
CallFinalSubroutine(descriptor, derived);
}
- const Descriptor &componentDesc{derived.component.descriptor()};
- std::int64_t myComponents{componentDesc.GetDimension(0).Extent()};
+ const Descriptor &componentDesc{derived.component()};
+ auto myComponents{static_cast<SubscriptValue>(componentDesc.Elements())};
std::size_t elements{descriptor.Elements()};
std::size_t byteStride{descriptor.ElementBytes()};
for (unsigned k{0}; k < myComponents; ++k) {
const auto &comp{
*componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
- if (comp.genre == typeInfo::Component::Genre::Allocatable ||
- comp.genre == typeInfo::Component::Genre::Automatic) {
+ if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
+ comp.genre() == typeInfo::Component::Genre::Automatic) {
for (std::size_t j{0}; j < elements; ++j) {
- descriptor.OffsetElement<Descriptor>(j * byteStride + comp.offset)
+ descriptor.OffsetElement<Descriptor>(j * byteStride + comp.offset())
->Deallocate(finalize);
}
- } else if (comp.genre == typeInfo::Component::Genre::Data &&
- comp.derivedType.descriptor().raw().base_addr) {
+ } else if (comp.genre() == typeInfo::Component::Genre::Data &&
+ comp.derivedType()) {
SubscriptValue extent[maxRank];
- const Descriptor &boundsDesc{comp.bounds.descriptor()};
- for (int dim{0}; dim < comp.rank; ++dim) {
- extent[dim] =
- GetValue(
- *boundsDesc.ZeroBasedIndexedElement<typeInfo::Value>(2 * dim),
- descriptor) -
- GetValue(*boundsDesc.ZeroBasedIndexedElement<typeInfo::Value>(
- 2 * dim + 1),
- descriptor) +
- 1;
+ const typeInfo::Value *bounds{comp.bounds()};
+ for (int dim{0}; dim < comp.rank(); ++dim) {
+ extent[dim] = bounds[2 * dim].GetValue(&descriptor).value_or(0) -
+ bounds[2 * dim + 1].GetValue(&descriptor).value_or(0) + 1;
}
StaticDescriptor<maxRank, true, 0> staticDescriptor;
Descriptor &compDesc{staticDescriptor.descriptor()};
- const auto &compType{*comp.derivedType.descriptor()
- .OffsetElement<typeInfo::DerivedType>()};
+ const typeInfo::DerivedType &compType{*comp.derivedType()};
for (std::size_t j{0}; j < elements; ++j) {
compDesc.Establish(compType,
- descriptor.OffsetElement<char>(j * byteStride + comp.offset),
- comp.rank, extent);
+ descriptor.OffsetElement<char>(j * byteStride + comp.offset()),
+ comp.rank(), extent);
Destroy(compDesc, finalize, compType);
}
}
}
- const Descriptor &parentDesc{derived.parent.descriptor()};
+ const Descriptor &parentDesc{derived.parent()};
if (const auto *parent{parentDesc.OffsetElement<typeInfo::DerivedType>()}) {
Destroy(descriptor, finalize, *parent);
}
#include "edit-output.h"
#include "io-stmt.h"
#include "terminator.h"
+#include "type-info.h"
#include "flang/Common/uint128.h"
namespace Fortran::runtime::io::descr {
const SubscriptValue subscripts[]) {
A *p{descriptor.Element<A>(subscripts)};
if (!p) {
- io.GetIoErrorHandler().Crash("ExtractElement: subscripts out of range");
+ io.GetIoErrorHandler().Crash(
+ "ExtractElement: null base address or subscripts out of range");
}
return *p;
}
}
template <Direction DIR>
+static bool DescriptorIO(IoStatementState &, const Descriptor &);
+
+template <Direction DIR>
+static bool DefaultFormattedComponentIO(IoStatementState &io,
+ const typeInfo::Component &component, const Descriptor &origDescriptor,
+ const SubscriptValue origSubscripts[], Terminator &terminator) {
+ if (component.genre() == typeInfo::Component::Genre::Data) {
+ // Create a descriptor for the component
+ StaticDescriptor<maxRank, true, 16 /*?*/> statDesc;
+ Descriptor &desc{statDesc.descriptor()};
+ component.EstablishDescriptor(
+ desc, origDescriptor, origSubscripts, terminator);
+ return DescriptorIO<DIR>(io, desc);
+ } else {
+ // Component is itself a descriptor
+ char *pointer{
+ origDescriptor.Element<char>(origSubscripts) + component.offset()};
+ RUNTIME_CHECK(
+ terminator, component.genre() == typeInfo::Component::Genre::Automatic);
+ const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)};
+ return DescriptorIO<DIR>(io, compDesc);
+ }
+}
+
+template <Direction DIR>
+static bool FormattedDerivedTypeIO(
+ IoStatementState &io, const Descriptor &descriptor) {
+ Terminator &terminator{io.GetIoErrorHandler()};
+ const DescriptorAddendum *addendum{descriptor.Addendum()};
+ RUNTIME_CHECK(terminator, addendum != nullptr);
+ const typeInfo::DerivedType *type{addendum->derivedType()};
+ RUNTIME_CHECK(terminator, type != nullptr);
+ if (false) {
+ // TODO: user-defined derived type formatted I/O
+ } else {
+ // Default derived type formatting
+ const Descriptor &compArray{type->component()};
+ RUNTIME_CHECK(terminator, compArray.rank() == 1);
+ std::size_t numComponents{compArray.Elements()};
+ std::size_t numElements{descriptor.Elements()};
+ SubscriptValue subscripts[maxRank];
+ descriptor.GetLowerBounds(subscripts);
+ for (std::size_t j{0}; j < numElements;
+ ++j, descriptor.IncrementSubscripts(subscripts)) {
+ SubscriptValue at[maxRank];
+ compArray.GetLowerBounds(at);
+ for (std::size_t k{0}; k < numComponents;
+ ++k, compArray.IncrementSubscripts(at)) {
+ const typeInfo::Component &component{
+ *compArray.Element<typeInfo::Component>(at)};
+ if (!DefaultFormattedComponentIO<DIR>(
+ io, component, descriptor, subscripts, terminator)) {
+ return false;
+ }
+ }
+ }
+ }
+ return true;
+}
+
+template <Direction DIR>
static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
if (!io.get_if<IoDirectionState<DIR>>()) {
io.GetIoErrorHandler().Crash(
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
std::size_t numElements{descriptor.Elements()};
- if (descriptor.IsContiguous()) { // contiguous unformatted I/O
+ if (false) {
+ // TODO: user-defined derived type unformatted I/O
+ } else if (descriptor.IsContiguous()) { // contiguous unformatted I/O
char &x{ExtractElement<char>(io, descriptor, subscripts)};
auto totalBytes{numElements * elementBytes};
if constexpr (DIR == Direction::Output) {
return false;
}
case TypeCategory::Derived:
- io.GetIoErrorHandler().Crash(
- "DescriptorIO: Unimplemented: derived type I/O",
- static_cast<int>(descriptor.type().raw()));
- return false;
+ return FormattedDerivedTypeIO<DIR>(io, descriptor);
}
}
io.GetIoErrorHandler().Crash("DescriptorIO: Bad type code (%d) in descriptor",
// incoming element length is replaced by 4 so that it will be valid
// for all CHARACTER kinds.
std::size_t workaroundElemLen{elementBytes ? elementBytes : 4};
- RUNTIME_CHECK(terminator,
- ISO::CFI_establish(&raw_, p, attribute, t.raw(), workaroundElemLen, rank,
- extent) == CFI_SUCCESS);
+ int cfiStatus{ISO::CFI_establish(
+ &raw_, p, attribute, t.raw(), workaroundElemLen, rank, extent)};
+ if (cfiStatus != CFI_SUCCESS) {
+ terminator.Crash(
+ "Descriptor::Establish: CFI_establish returned %d", cfiStatus, t.raw());
+ }
if (elementBytes == 0) {
raw_.elem_len = 0;
for (int j{0}; j < rank; ++j) {
void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank,
const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
- Establish(CFI_type_struct, dt.sizeInBytes, p, rank, extent, attribute, true);
+ Establish(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
+ extent, attribute, true);
DescriptorAddendum *a{Addendum()};
Terminator terminator{__FILE__, __LINE__};
RUNTIME_CHECK(terminator, a != nullptr);
OwningPtr<Descriptor> Descriptor::Create(const typeInfo::DerivedType &dt,
void *p, int rank, const SubscriptValue *extent,
ISO::CFI_attribute_t attribute) {
- return Create(TypeCode{CFI_type_struct}, dt.sizeInBytes, p, rank, extent,
- attribute, dt.LenParameters());
+ return Create(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
+ extent, attribute, dt.LenParameters());
}
std::size_t Descriptor::SizeInBytes() const {
return len_[which];
}
static constexpr std::size_t SizeInBytes(int lenParameters) {
- return sizeof(DescriptorAddendum) - sizeof(typeInfo::TypeParameterValue) +
- lenParameters * sizeof(typeInfo::TypeParameterValue);
+ // TODO: Don't waste that last word if lenParameters == 0
+ return sizeof(DescriptorAddendum) +
+ std::max(lenParameters - 1, 0) * sizeof(typeInfo::TypeParameterValue);
}
std::size_t SizeInBytes() const;
namespace Fortran::runtime::io {
+// Max size of a group, symbol or component identifier that can appear in
+// NAMELIST input, plus a byte for NUL termination.
+static constexpr std::size_t nameBufferSize{201};
+
bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
IoStatementState &io{*cookie};
io.CheckFormattedStmtType<Direction::Output>("OutputNamelist");
return EmitWithAdvance('/');
}
+static constexpr bool IsLegalIdStart(char32_t ch) {
+ return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || ch == '_' ||
+ ch == '@' || ch == '$';
+}
+
+static constexpr bool IsLegalIdChar(char32_t ch) {
+ return IsLegalIdStart(ch) || (ch >= '0' && ch <= '9');
+}
+
+static constexpr char NormalizeIdChar(char32_t ch) {
+ return static_cast<char>(ch >= 'A' && ch <= 'Z' ? ch - 'A' + 'a' : ch);
+}
+
static bool GetLowerCaseName(
IoStatementState &io, char buffer[], std::size_t maxLength) {
- if (auto ch{io.GetCurrentChar()}) {
- static const auto IsLegalIdStart{[](char32_t ch) -> bool {
- return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') ||
- ch == '_' || ch == '@' || ch == '$';
- }};
+ if (auto ch{io.GetNextNonBlank()}) {
if (IsLegalIdStart(*ch)) {
std::size_t j{0};
do {
- buffer[j] =
- static_cast<char>(*ch >= 'A' && *ch <= 'Z' ? *ch - 'A' + 'a' : *ch);
+ buffer[j] = NormalizeIdChar(*ch);
io.HandleRelativePosition(1);
ch = io.GetCurrentChar();
- } while (++j < maxLength && ch &&
- (IsLegalIdStart(*ch) || (*ch >= '0' && *ch <= '9')));
+ } while (++j < maxLength && ch && IsLegalIdChar(*ch));
buffer[j++] = '\0';
if (j <= maxLength) {
return true;
const Descriptor &source, const char *name) {
IoErrorHandler &handler{io.GetIoErrorHandler()};
io.HandleRelativePosition(1); // skip '('
- // Allow for blanks in subscripts; it's nonstandard, but not ambiguous
- // within the parentheses
+ // Allow for blanks in subscripts; they're nonstandard, but not
+ // ambiguous within the parentheses.
SubscriptValue lower[maxRank], upper[maxRank], stride[maxRank];
int j{0};
std::size_t elemLen{source.ElementBytes()};
return false;
}
+static bool HandleComponent(IoStatementState &io, Descriptor &desc,
+ const Descriptor &source, const char *name) {
+ IoErrorHandler &handler{io.GetIoErrorHandler()};
+ io.HandleRelativePosition(1); // skip '%'
+ char compName[nameBufferSize];
+ if (GetLowerCaseName(io, compName, sizeof compName)) {
+ const DescriptorAddendum *addendum{source.Addendum()};
+ if (const typeInfo::DerivedType *
+ type{addendum ? addendum->derivedType() : nullptr}) {
+ if (const typeInfo::Component *
+ comp{type->FindDataComponent(compName, std::strlen(compName))}) {
+ comp->EstablishDescriptor(desc, source, nullptr, handler);
+ return true;
+ } else {
+ handler.SignalError(
+ "NAMELIST component reference '%%%s' of input group item %s is not "
+ "a component of its derived type",
+ compName, name);
+ }
+ } else {
+ handler.SignalError("NAMELIST component reference '%%%s' of input group "
+ "item %s for non-derived type",
+ compName, name);
+ }
+ } else {
+ handler.SignalError("NAMELIST component reference of input group item %s "
+ "has no name after '%'",
+ name);
+ }
+ return false;
+}
+
bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
IoStatementState &io{*cookie};
io.CheckFormattedStmtType<Direction::Input>("InputNamelist");
return false;
}
io.HandleRelativePosition(1);
- char name[101];
+ char name[nameBufferSize];
if (!GetLowerCaseName(io, name, sizeof name)) {
handler.SignalError("NAMELIST input group has no name");
return false;
next = io.GetCurrentChar();
if (next && (*next == '(' || *next == '%')) {
do {
+ Descriptor &mutableDescriptor{staticDesc[whichStaticDesc].descriptor()};
+ whichStaticDesc ^= 1;
if (*next == '(') {
- Descriptor &mutableDescriptor{
- staticDesc[whichStaticDesc].descriptor()};
- whichStaticDesc ^= 1;
HandleSubscripts(io, mutableDescriptor, *useDescriptor, name);
- useDescriptor = &mutableDescriptor;
} else {
- handler.Crash("unimplemented: component references in NAMELIST");
+ HandleComponent(io, mutableDescriptor, *useDescriptor, name);
}
+ useDescriptor = &mutableDescriptor;
next = io.GetCurrentChar();
} while (next && (*next == '(' || *next == '%'));
}
}
return std::nullopt;
}
+
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_TOOLS_H_
--- /dev/null
+//===-- runtime/type-info.cpp ---------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "type-info.h"
+#include "terminator.h"
+#include <cstdio>
+
+namespace Fortran::runtime::typeInfo {
+
+std::optional<TypeParameterValue> Value::GetValue(
+ const Descriptor *descriptor) const {
+ switch (genre_) {
+ case Genre::Explicit:
+ return value_;
+ case Genre::LenParameter:
+ if (descriptor) {
+ if (const auto *addendum{descriptor->Addendum()}) {
+ return addendum->LenParameterValue(value_);
+ }
+ }
+ return std::nullopt;
+ default:
+ return std::nullopt;
+ }
+}
+
+void Component::EstablishDescriptor(Descriptor &descriptor,
+ const Descriptor &container, const SubscriptValue subscripts[],
+ Terminator &terminator) const {
+ RUNTIME_CHECK(terminator, genre_ == Genre::Data);
+ TypeCategory cat{category()};
+ if (cat == TypeCategory::Character) {
+ auto length{characterLen_.GetValue(&container)};
+ RUNTIME_CHECK(terminator, length.has_value());
+ descriptor.Establish(kind_, *length / kind_, nullptr, rank_);
+ } else if (cat == TypeCategory::Derived) {
+ const DerivedType *type{derivedType()};
+ RUNTIME_CHECK(terminator, type != nullptr);
+ descriptor.Establish(*type, nullptr, rank_);
+ } else {
+ descriptor.Establish(cat, kind_, nullptr, rank_);
+ }
+ if (rank_) {
+ const typeInfo::Value *boundValues{bounds()};
+ RUNTIME_CHECK(terminator, boundValues != nullptr);
+ auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
+ for (int j{0}; j < rank_; ++j) {
+ auto lb{boundValues++->GetValue(&container)};
+ auto ub{boundValues++->GetValue(&container)};
+ RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value());
+ Dimension &dim{descriptor.GetDimension(j)};
+ dim.SetBounds(*lb, *ub);
+ dim.SetByteStride(byteStride);
+ byteStride *= dim.Extent();
+ }
+ }
+ descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
+}
+
+const Component *DerivedType::FindDataComponent(
+ const char *compName, std::size_t compNameLen) const {
+ const Descriptor &compDesc{component()};
+ std::size_t n{compDesc.Elements()};
+ SubscriptValue at[maxRank];
+ compDesc.GetLowerBounds(at);
+ for (std::size_t j{0}; j < n; ++j, compDesc.IncrementSubscripts(at)) {
+ const Component *component{compDesc.Element<Component>(at)};
+ INTERNAL_CHECK(component != nullptr);
+ const Descriptor &nameDesc{component->name()};
+ if (nameDesc.ElementBytes() == compNameLen &&
+ std::memcmp(compName, nameDesc.OffsetElement(), compNameLen) == 0) {
+ return component;
+ }
+ }
+ const DerivedType *ancestor{parent().OffsetElement<DerivedType>()};
+ return ancestor ? ancestor->FindDataComponent(compName, compNameLen)
+ : nullptr;
+}
+
+static void DumpScalarCharacter(
+ FILE *f, const Descriptor &desc, const char *what) {
+ if (desc.raw().version == CFI_VERSION &&
+ desc.type() == TypeCode{TypeCategory::Character, 1} &&
+ desc.ElementBytes() > 0 && desc.rank() == 0 &&
+ desc.OffsetElement() != nullptr) {
+ std::fwrite(desc.OffsetElement(), desc.ElementBytes(), 1, f);
+ } else {
+ std::fprintf(f, "bad %s descriptor: ", what);
+ desc.Dump(f);
+ }
+}
+
+FILE *DerivedType::Dump(FILE *f) const {
+ std::fprintf(
+ f, "DerivedType @ 0x%p:\n", reinterpret_cast<const void *>(this));
+ const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)};
+ for (int j{0}; j < 64; ++j) {
+ int offset{j * static_cast<int>(sizeof *uints)};
+ std::fprintf(f, " [+%3d](0x%p) %#016jx", offset,
+ reinterpret_cast<const void *>(&uints[j]),
+ static_cast<std::intmax_t>(uints[j]));
+ if (offset == offsetof(DerivedType, binding_)) {
+ std::fputs(" <-- binding_\n", f);
+ } else if (offset == offsetof(DerivedType, name_)) {
+ std::fputs(" <-- name_\n", f);
+ } else if (offset == offsetof(DerivedType, sizeInBytes_)) {
+ std::fputs(" <-- sizeInBytes_\n", f);
+ } else if (offset == offsetof(DerivedType, parent_)) {
+ std::fputs(" <-- parent_\n", f);
+ } else if (offset == offsetof(DerivedType, uninstantiated_)) {
+ std::fputs(" <-- uninstantiated_\n", f);
+ } else if (offset == offsetof(DerivedType, typeHash_)) {
+ std::fputs(" <-- typeHash_\n", f);
+ } else if (offset == offsetof(DerivedType, kindParameter_)) {
+ std::fputs(" <-- kindParameter_\n", f);
+ } else if (offset == offsetof(DerivedType, lenParameterKind_)) {
+ std::fputs(" <-- lenParameterKind_\n", f);
+ } else if (offset == offsetof(DerivedType, component_)) {
+ std::fputs(" <-- component_\n", f);
+ } else if (offset == offsetof(DerivedType, procPtr_)) {
+ std::fputs(" <-- procPtr_\n", f);
+ } else if (offset == offsetof(DerivedType, special_)) {
+ std::fputs(" <-- special_\n", f);
+ } else {
+ std::fputc('\n', f);
+ }
+ }
+ std::fputs(" name: ", f);
+ DumpScalarCharacter(f, name(), "DerivedType::name");
+ const Descriptor &bindingDesc{binding()};
+ std::fprintf(
+ f, "\n binding descriptor (byteSize 0x%zx): ", binding_.byteSize);
+ bindingDesc.Dump(f);
+ const Descriptor &compDesc{component()};
+ std::fputs("\n components:\n", f);
+ if (compDesc.raw().version == CFI_VERSION &&
+ compDesc.type() == TypeCode{TypeCategory::Derived, 0} &&
+ compDesc.ElementBytes() == sizeof(Component) && compDesc.rank() == 1) {
+ std::size_t n{compDesc.Elements()};
+ for (std::size_t j{0}; j < n; ++j) {
+ const Component &comp{*compDesc.ZeroBasedIndexedElement<Component>(j)};
+ std::fprintf(f, " [%3zd] ", j);
+ comp.Dump(f);
+ }
+ } else {
+ std::fputs(" bad descriptor: ", f);
+ compDesc.Dump(f);
+ }
+ return f;
+}
+
+FILE *Component::Dump(FILE *f) const {
+ std::fprintf(f, "Component @ 0x%p:\n", reinterpret_cast<const void *>(this));
+ std::fputs(" name: ", f);
+ DumpScalarCharacter(f, name(), "Component::name");
+ switch (genre_) {
+ case Genre::Data:
+ std::fputs(" Data ", f);
+ break;
+ case Genre::Pointer:
+ std::fputs(" Pointer ", f);
+ break;
+ case Genre::Allocatable:
+ std::fputs(" Allocatable", f);
+ break;
+ case Genre::Automatic:
+ std::fputs(" Automatic ", f);
+ break;
+ default:
+ std::fprintf(f, " (bad genre 0x%x)", static_cast<int>(genre_));
+ break;
+ }
+ std::fprintf(f, " category %d kind %d rank %d offset 0x%zx\n", category_,
+ kind_, rank_, static_cast<std::size_t>(offset_));
+ return f;
+}
+
+} // namespace Fortran::runtime::typeInfo
#include "flang/Common/Fortran.h"
#include <cinttypes>
#include <memory>
+#include <optional>
namespace Fortran::runtime::typeInfo {
+struct Component;
+
class DerivedType {
public:
- ~DerivedType();
+ ~DerivedType(); // never defined
+
+ const Descriptor &binding() const { return binding_.descriptor(); }
+ const Descriptor &name() const { return name_.descriptor(); }
+ std::uint64_t sizeInBytes() const { return sizeInBytes_; }
+ const Descriptor &parent() const { return parent_.descriptor(); }
+ std::uint64_t typeHash() const { return typeHash_; }
+ const Descriptor &uninstatiated() const {
+ return uninstantiated_.descriptor();
+ }
+ const Descriptor &kindParameter() const {
+ return kindParameter_.descriptor();
+ }
+ const Descriptor &lenParameterKind() const {
+ return lenParameterKind_.descriptor();
+ }
+ const Descriptor &component() const { return component_.descriptor(); }
+ const Descriptor &procPtr() const { return procPtr_.descriptor(); }
+ const Descriptor &special() const { return special_.descriptor(); }
+
+ std::size_t LenParameters() const { return lenParameterKind().Elements(); }
+
+ // Finds a data component by name in this derived type or tis ancestors.
+ const Component *FindDataComponent(
+ const char *name, std::size_t nameLen) const;
+ FILE *Dump(FILE * = stdout) const;
+
+private:
// This member comes first because it's used like a vtable by generated code.
// It includes all of the ancestor types' bindings, if any, first,
// with any overrides from descendants already applied to them. Local
// bindings then follow in alphabetic order of binding name.
StaticDescriptor<1, true>
- binding; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
+ binding_; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
- StaticDescriptor<0> name; // CHARACTER(:), POINTER
+ StaticDescriptor<0> name_; // CHARACTER(:), POINTER
- std::uint64_t sizeInBytes{0};
- StaticDescriptor<0, true> parent; // TYPE(DERIVEDTYPE), POINTER
+ std::uint64_t sizeInBytes_{0};
+ StaticDescriptor<0, true> parent_; // TYPE(DERIVEDTYPE), POINTER
// Instantiations of a parameterized derived type with KIND type
// parameters will point this data member to the description of
// module via use association. The original uninstantiated derived
// type description will point to itself. Derived types that have
// no KIND type parameters will have a null pointer here.
- StaticDescriptor<0, true> uninstantiated; // TYPE(DERIVEDTYPE), POINTER
+ StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER
// TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2)
- std::uint64_t typeHash{0};
+ std::uint64_t typeHash_{0};
// These pointer targets include all of the items from the parent, if any.
- StaticDescriptor<1> kindParameter; // pointer to rank-1 array of INTEGER(8)
- StaticDescriptor<1> lenParameterKind; // pointer to rank-1 array of INTEGER(1)
+ StaticDescriptor<1> kindParameter_; // pointer to rank-1 array of INTEGER(8)
+ StaticDescriptor<1>
+ lenParameterKind_; // pointer to rank-1 array of INTEGER(1)
// This array of local data components includes the parent component.
// Components are in alphabetic order.
+ // TODO pmk: fix to be "component order"
// It does not include procedure pointer components.
StaticDescriptor<1, true>
- component; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
+ component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
// Procedure pointer components
StaticDescriptor<1, true>
- procPtr; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
+ procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
// Does not include special bindings from ancestral types.
StaticDescriptor<1, true>
- special; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
-
- std::size_t LenParameters() const {
- return lenParameterKind.descriptor().Elements();
- }
+ special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
};
using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
StaticDescriptor<0> name; // CHARACTER(:), POINTER
};
-struct Value {
+class Value {
+public:
enum class Genre : std::uint8_t {
Deferred = 1,
Explicit = 2,
LenParameter = 3
};
- Genre genre{Genre::Explicit};
+
+ std::optional<TypeParameterValue> GetValue(const Descriptor *) const;
+
+private:
+ Genre genre_{Genre::Explicit};
// The value encodes an index into the table of LEN type parameters in
// a descriptor's addendum for genre == Genre::LenParameter.
- TypeParameterValue value{0};
+ TypeParameterValue value_{0};
};
-struct Component {
- enum class Genre : std::uint8_t { Data, Pointer, Allocatable, Automatic };
- StaticDescriptor<0> name; // CHARACTER(:), POINTER
- Genre genre{Genre::Data};
- std::uint8_t category; // common::TypeCategory
- std::uint8_t kind{0};
- std::uint8_t rank{0};
- std::uint64_t offset{0};
- Value characterLen; // for TypeCategory::Character
- StaticDescriptor<0, true> derivedType; // TYPE(DERIVEDTYPE), POINTER
+class Component {
+public:
+ enum class Genre : std::uint8_t {
+ Data = 1,
+ Pointer = 2,
+ Allocatable = 3,
+ Automatic = 4
+ };
+
+ const Descriptor &name() const { return name_.descriptor(); }
+ Genre genre() const { return genre_; }
+ TypeCategory category() const { return static_cast<TypeCategory>(category_); }
+ int kind() const { return kind_; }
+ int rank() const { return rank_; }
+ std::uint64_t offset() const { return offset_; }
+ const Value &characterLen() const { return characterLen_; }
+ const DerivedType *derivedType() const {
+ return derivedType_.descriptor().OffsetElement<const DerivedType>();
+ }
+ const Value *lenValue() const {
+ return lenValue_.descriptor().OffsetElement<const Value>();
+ }
+ const Value *bounds() const {
+ return bounds_.descriptor().OffsetElement<const Value>();
+ }
+ const char *initialization() const { return initialization_; }
+
+ // Creates a pointer descriptor from a component description.
+ void EstablishDescriptor(Descriptor &, const Descriptor &container,
+ const SubscriptValue[], Terminator &) const;
+
+ FILE *Dump(FILE * = stdout) const;
+
+private:
+ StaticDescriptor<0> name_; // CHARACTER(:), POINTER
+ Genre genre_{Genre::Data};
+ std::uint8_t category_; // common::TypeCategory
+ std::uint8_t kind_{0};
+ std::uint8_t rank_{0};
+ std::uint64_t offset_{0};
+ Value characterLen_; // for TypeCategory::Character
+ StaticDescriptor<0, true> derivedType_; // TYPE(DERIVEDTYPE), POINTER
StaticDescriptor<1, true>
- lenValue; // TYPE(VALUE), POINTER, DIMENSION(:), CONTIGUOUS
+ lenValue_; // TYPE(VALUE), POINTER, DIMENSION(:), CONTIGUOUS
StaticDescriptor<2, true>
- bounds; // TYPE(VALUE), POINTER, DIMENSION(2,:), CONTIGUOUS
- char *initialization{nullptr}; // for Genre::Data and Pointer
+ bounds_; // TYPE(VALUE), POINTER, DIMENSION(2,:), CONTIGUOUS
+ const char *initialization_{nullptr}; // for Genre::Data and Pointer
// TODO: cobounds
// TODO: `PRIVATE` attribute
};
type, extends(parent) :: child
integer :: cn
end type
-!CHECK: .c.child, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.parent,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.child, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.parent,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .c.parent, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.pn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .dt.child, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,parent=.dt.parent,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL())
!CHECK: .dt.parent, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL())
contains
subroutine s1(x)
!CHECK: .b.t.1.automatic, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=2_1,value=1_8),value(genre=3_1,value=0_8)],shape=[2,1])
-!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL()),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=target)]
+!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=target),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL())]
!CHECK: .dt.t.1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,parent=NULL(),uninstantiated=.dt.t,kindparameter=NULL(),lenparameterkind=.lpk.t.1,component=.c.t.1,procptr=NULL(),special=NULL())
!CHECK: .lpk.t.1, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
type(t(*)), intent(in) :: x