mirror of
https://github.com/llvm/llvm-project.git
synced 2025-04-17 04:06:46 +00:00
ade9d1f810
The RUNTIME_CHECK in question doesn't allow for the possibility that an allocatable or pointer component could be processed by defined I/O. Remove it in favor of a dynamic allocation check.
628 lines
24 KiB
C++
628 lines
24 KiB
C++
//===-- lib/runtime/descriptor-io.h -----------------------------*- C++ -*-===//
|
|
//
|
|
// 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
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#ifndef FLANG_RT_RUNTIME_DESCRIPTOR_IO_H_
|
|
#define FLANG_RT_RUNTIME_DESCRIPTOR_IO_H_
|
|
|
|
// Implementation of I/O data list item transfers based on descriptors.
|
|
// (All I/O items come through here so that the code is exercised for test;
|
|
// some scalar I/O data transfer APIs could be changed to bypass their use
|
|
// of descriptors in the future for better efficiency.)
|
|
|
|
#include "edit-input.h"
|
|
#include "edit-output.h"
|
|
#include "unit.h"
|
|
#include "flang-rt/runtime/descriptor.h"
|
|
#include "flang-rt/runtime/io-stmt.h"
|
|
#include "flang-rt/runtime/namelist.h"
|
|
#include "flang-rt/runtime/terminator.h"
|
|
#include "flang-rt/runtime/type-info.h"
|
|
#include "flang/Common/optional.h"
|
|
#include "flang/Common/uint128.h"
|
|
#include "flang/Runtime/cpp-type.h"
|
|
|
|
namespace Fortran::runtime::io::descr {
|
|
template <typename A>
|
|
inline RT_API_ATTRS A &ExtractElement(IoStatementState &io,
|
|
const Descriptor &descriptor, const SubscriptValue subscripts[]) {
|
|
A *p{descriptor.Element<A>(subscripts)};
|
|
if (!p) {
|
|
io.GetIoErrorHandler().Crash("Bad address for I/O item -- null base "
|
|
"address or subscripts out of range");
|
|
}
|
|
return *p;
|
|
}
|
|
|
|
// Per-category descriptor-based I/O templates
|
|
|
|
// TODO (perhaps as a nontrivial but small starter project): implement
|
|
// automatic repetition counts, like "10*3.14159", for list-directed and
|
|
// NAMELIST array output.
|
|
|
|
template <int KIND, Direction DIR>
|
|
inline RT_API_ATTRS bool FormattedIntegerIO(IoStatementState &io,
|
|
const Descriptor &descriptor, [[maybe_unused]] bool isSigned) {
|
|
std::size_t numElements{descriptor.Elements()};
|
|
SubscriptValue subscripts[maxRank];
|
|
descriptor.GetLowerBounds(subscripts);
|
|
using IntType = CppTypeFor<common::TypeCategory::Integer, KIND>;
|
|
bool anyInput{false};
|
|
for (std::size_t j{0}; j < numElements; ++j) {
|
|
if (auto edit{io.GetNextDataEdit()}) {
|
|
IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
|
|
if constexpr (DIR == Direction::Output) {
|
|
if (!EditIntegerOutput<KIND>(io, *edit, x, isSigned)) {
|
|
return false;
|
|
}
|
|
} else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
|
|
if (EditIntegerInput(
|
|
io, *edit, reinterpret_cast<void *>(&x), KIND, isSigned)) {
|
|
anyInput = true;
|
|
} else {
|
|
return anyInput && edit->IsNamelist();
|
|
}
|
|
}
|
|
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
|
|
io.GetIoErrorHandler().Crash(
|
|
"FormattedIntegerIO: subscripts out of bounds");
|
|
}
|
|
} else {
|
|
return false;
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
|
|
template <int KIND, Direction DIR>
|
|
inline RT_API_ATTRS bool FormattedRealIO(
|
|
IoStatementState &io, const Descriptor &descriptor) {
|
|
std::size_t numElements{descriptor.Elements()};
|
|
SubscriptValue subscripts[maxRank];
|
|
descriptor.GetLowerBounds(subscripts);
|
|
using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
|
|
bool anyInput{false};
|
|
for (std::size_t j{0}; j < numElements; ++j) {
|
|
if (auto edit{io.GetNextDataEdit()}) {
|
|
RawType &x{ExtractElement<RawType>(io, descriptor, subscripts)};
|
|
if constexpr (DIR == Direction::Output) {
|
|
if (!RealOutputEditing<KIND>{io, x}.Edit(*edit)) {
|
|
return false;
|
|
}
|
|
} else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
|
|
if (EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) {
|
|
anyInput = true;
|
|
} else {
|
|
return anyInput && edit->IsNamelist();
|
|
}
|
|
}
|
|
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
|
|
io.GetIoErrorHandler().Crash(
|
|
"FormattedRealIO: subscripts out of bounds");
|
|
}
|
|
} else {
|
|
return false;
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
|
|
template <int KIND, Direction DIR>
|
|
inline RT_API_ATTRS bool FormattedComplexIO(
|
|
IoStatementState &io, const Descriptor &descriptor) {
|
|
std::size_t numElements{descriptor.Elements()};
|
|
SubscriptValue subscripts[maxRank];
|
|
descriptor.GetLowerBounds(subscripts);
|
|
bool isListOutput{
|
|
io.get_if<ListDirectedStatementState<Direction::Output>>() != nullptr};
|
|
using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
|
|
bool anyInput{false};
|
|
for (std::size_t j{0}; j < numElements; ++j) {
|
|
RawType *x{&ExtractElement<RawType>(io, descriptor, subscripts)};
|
|
if (isListOutput) {
|
|
DataEdit rEdit, iEdit;
|
|
rEdit.descriptor = DataEdit::ListDirectedRealPart;
|
|
iEdit.descriptor = DataEdit::ListDirectedImaginaryPart;
|
|
rEdit.modes = iEdit.modes = io.mutableModes();
|
|
if (!RealOutputEditing<KIND>{io, x[0]}.Edit(rEdit) ||
|
|
!RealOutputEditing<KIND>{io, x[1]}.Edit(iEdit)) {
|
|
return false;
|
|
}
|
|
} else {
|
|
for (int k{0}; k < 2; ++k, ++x) {
|
|
auto edit{io.GetNextDataEdit()};
|
|
if (!edit) {
|
|
return false;
|
|
} else if constexpr (DIR == Direction::Output) {
|
|
if (!RealOutputEditing<KIND>{io, *x}.Edit(*edit)) {
|
|
return false;
|
|
}
|
|
} else if (edit->descriptor == DataEdit::ListDirectedNullValue) {
|
|
break;
|
|
} else if (EditRealInput<KIND>(
|
|
io, *edit, reinterpret_cast<void *>(x))) {
|
|
anyInput = true;
|
|
} else {
|
|
return anyInput && edit->IsNamelist();
|
|
}
|
|
}
|
|
}
|
|
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
|
|
io.GetIoErrorHandler().Crash(
|
|
"FormattedComplexIO: subscripts out of bounds");
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
|
|
template <typename A, Direction DIR>
|
|
inline RT_API_ATTRS bool FormattedCharacterIO(
|
|
IoStatementState &io, const Descriptor &descriptor) {
|
|
std::size_t numElements{descriptor.Elements()};
|
|
SubscriptValue subscripts[maxRank];
|
|
descriptor.GetLowerBounds(subscripts);
|
|
std::size_t length{descriptor.ElementBytes() / sizeof(A)};
|
|
auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
|
|
bool anyInput{false};
|
|
for (std::size_t j{0}; j < numElements; ++j) {
|
|
A *x{&ExtractElement<A>(io, descriptor, subscripts)};
|
|
if (listOutput) {
|
|
if (!ListDirectedCharacterOutput(io, *listOutput, x, length)) {
|
|
return false;
|
|
}
|
|
} else if (auto edit{io.GetNextDataEdit()}) {
|
|
if constexpr (DIR == Direction::Output) {
|
|
if (!EditCharacterOutput(io, *edit, x, length)) {
|
|
return false;
|
|
}
|
|
} else { // input
|
|
if (edit->descriptor != DataEdit::ListDirectedNullValue) {
|
|
if (EditCharacterInput(io, *edit, x, length)) {
|
|
anyInput = true;
|
|
} else {
|
|
return anyInput && edit->IsNamelist();
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
return false;
|
|
}
|
|
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
|
|
io.GetIoErrorHandler().Crash(
|
|
"FormattedCharacterIO: subscripts out of bounds");
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
|
|
template <int KIND, Direction DIR>
|
|
inline RT_API_ATTRS bool FormattedLogicalIO(
|
|
IoStatementState &io, const Descriptor &descriptor) {
|
|
std::size_t numElements{descriptor.Elements()};
|
|
SubscriptValue subscripts[maxRank];
|
|
descriptor.GetLowerBounds(subscripts);
|
|
auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
|
|
using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
|
|
bool anyInput{false};
|
|
for (std::size_t j{0}; j < numElements; ++j) {
|
|
IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
|
|
if (listOutput) {
|
|
if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) {
|
|
return false;
|
|
}
|
|
} else if (auto edit{io.GetNextDataEdit()}) {
|
|
if constexpr (DIR == Direction::Output) {
|
|
if (!EditLogicalOutput(io, *edit, x != 0)) {
|
|
return false;
|
|
}
|
|
} else {
|
|
if (edit->descriptor != DataEdit::ListDirectedNullValue) {
|
|
bool truth{};
|
|
if (EditLogicalInput(io, *edit, truth)) {
|
|
x = truth;
|
|
anyInput = true;
|
|
} else {
|
|
return anyInput && edit->IsNamelist();
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
return false;
|
|
}
|
|
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
|
|
io.GetIoErrorHandler().Crash(
|
|
"FormattedLogicalIO: subscripts out of bounds");
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
|
|
template <Direction DIR>
|
|
static RT_API_ATTRS bool DescriptorIO(IoStatementState &, const Descriptor &,
|
|
const NonTbpDefinedIoTable * = nullptr);
|
|
|
|
// For intrinsic (not defined) derived type I/O, formatted & unformatted
|
|
template <Direction DIR>
|
|
static RT_API_ATTRS bool DefaultComponentIO(IoStatementState &io,
|
|
const typeInfo::Component &component, const Descriptor &origDescriptor,
|
|
const SubscriptValue origSubscripts[], Terminator &terminator,
|
|
const NonTbpDefinedIoTable *table) {
|
|
#if !defined(RT_DEVICE_AVOID_RECURSION)
|
|
if (component.genre() == typeInfo::Component::Genre::Data) {
|
|
// Create a descriptor for the component
|
|
StaticDescriptor<maxRank, true, 16 /*?*/> statDesc;
|
|
Descriptor &desc{statDesc.descriptor()};
|
|
component.CreatePointerDescriptor(
|
|
desc, origDescriptor, terminator, origSubscripts);
|
|
return DescriptorIO<DIR>(io, desc, table);
|
|
} else {
|
|
// Component is itself a descriptor
|
|
char *pointer{
|
|
origDescriptor.Element<char>(origSubscripts) + component.offset()};
|
|
const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)};
|
|
return compDesc.IsAllocated() && DescriptorIO<DIR>(io, compDesc, table);
|
|
}
|
|
#else
|
|
terminator.Crash("not yet implemented: component IO");
|
|
#endif
|
|
}
|
|
|
|
template <Direction DIR>
|
|
static RT_API_ATTRS bool DefaultComponentwiseFormattedIO(IoStatementState &io,
|
|
const Descriptor &descriptor, const typeInfo::DerivedType &type,
|
|
const NonTbpDefinedIoTable *table, const SubscriptValue subscripts[]) {
|
|
IoErrorHandler &handler{io.GetIoErrorHandler()};
|
|
const Descriptor &compArray{type.component()};
|
|
RUNTIME_CHECK(handler, compArray.rank() == 1);
|
|
std::size_t numComponents{compArray.Elements()};
|
|
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 (!DefaultComponentIO<DIR>(
|
|
io, component, descriptor, subscripts, handler, table)) {
|
|
// Return true for NAMELIST input if any component appeared.
|
|
auto *listInput{
|
|
io.get_if<ListDirectedStatementState<Direction::Input>>()};
|
|
return DIR == Direction::Input && k > 0 && listInput &&
|
|
listInput->inNamelistSequence();
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
|
|
template <Direction DIR>
|
|
static RT_API_ATTRS bool DefaultComponentwiseUnformattedIO(IoStatementState &io,
|
|
const Descriptor &descriptor, const typeInfo::DerivedType &type,
|
|
const NonTbpDefinedIoTable *table) {
|
|
IoErrorHandler &handler{io.GetIoErrorHandler()};
|
|
const Descriptor &compArray{type.component()};
|
|
RUNTIME_CHECK(handler, 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 (!DefaultComponentIO<DIR>(
|
|
io, component, descriptor, subscripts, handler, table)) {
|
|
return false;
|
|
}
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
|
|
RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
|
|
IoStatementState &, const Descriptor &, const typeInfo::DerivedType &,
|
|
const typeInfo::SpecialBinding &, const SubscriptValue[]);
|
|
|
|
template <Direction DIR>
|
|
static RT_API_ATTRS bool FormattedDerivedTypeIO(IoStatementState &io,
|
|
const Descriptor &descriptor, const NonTbpDefinedIoTable *table) {
|
|
IoErrorHandler &handler{io.GetIoErrorHandler()};
|
|
// Derived type information must be present for formatted I/O.
|
|
const DescriptorAddendum *addendum{descriptor.Addendum()};
|
|
RUNTIME_CHECK(handler, addendum != nullptr);
|
|
const typeInfo::DerivedType *type{addendum->derivedType()};
|
|
RUNTIME_CHECK(handler, type != nullptr);
|
|
Fortran::common::optional<typeInfo::SpecialBinding> nonTbpSpecial;
|
|
const typeInfo::SpecialBinding *special{nullptr};
|
|
if (table) {
|
|
if (const auto *definedIo{table->Find(*type,
|
|
DIR == Direction::Input ? common::DefinedIo::ReadFormatted
|
|
: common::DefinedIo::WriteFormatted)}) {
|
|
if (definedIo->subroutine) {
|
|
nonTbpSpecial.emplace(DIR == Direction::Input
|
|
? typeInfo::SpecialBinding::Which::ReadFormatted
|
|
: typeInfo::SpecialBinding::Which::WriteFormatted,
|
|
definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
|
|
false);
|
|
special = &*nonTbpSpecial;
|
|
}
|
|
}
|
|
}
|
|
if (!special) {
|
|
if (const typeInfo::SpecialBinding *
|
|
binding{type->FindSpecialBinding(DIR == Direction::Input
|
|
? typeInfo::SpecialBinding::Which::ReadFormatted
|
|
: typeInfo::SpecialBinding::Which::WriteFormatted)}) {
|
|
if (!table || !table->ignoreNonTbpEntries || binding->isTypeBound()) {
|
|
special = binding;
|
|
}
|
|
}
|
|
}
|
|
SubscriptValue subscripts[maxRank];
|
|
descriptor.GetLowerBounds(subscripts);
|
|
std::size_t numElements{descriptor.Elements()};
|
|
for (std::size_t j{0}; j < numElements;
|
|
++j, descriptor.IncrementSubscripts(subscripts)) {
|
|
Fortran::common::optional<bool> result;
|
|
if (special) {
|
|
result = DefinedFormattedIo(io, descriptor, *type, *special, subscripts);
|
|
}
|
|
if (!result) {
|
|
result = DefaultComponentwiseFormattedIO<DIR>(
|
|
io, descriptor, *type, table, subscripts);
|
|
}
|
|
if (!result.value()) {
|
|
// Return true for NAMELIST input if we got anything.
|
|
auto *listInput{
|
|
io.get_if<ListDirectedStatementState<Direction::Input>>()};
|
|
return DIR == Direction::Input && j > 0 && listInput &&
|
|
listInput->inNamelistSequence();
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
|
|
RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
|
|
const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
|
|
|
|
// Unformatted I/O
|
|
template <Direction DIR>
|
|
static RT_API_ATTRS bool UnformattedDescriptorIO(IoStatementState &io,
|
|
const Descriptor &descriptor, const NonTbpDefinedIoTable *table = nullptr) {
|
|
IoErrorHandler &handler{io.GetIoErrorHandler()};
|
|
const DescriptorAddendum *addendum{descriptor.Addendum()};
|
|
if (const typeInfo::DerivedType *
|
|
type{addendum ? addendum->derivedType() : nullptr}) {
|
|
// derived type unformatted I/O
|
|
if (table) {
|
|
if (const auto *definedIo{table->Find(*type,
|
|
DIR == Direction::Input ? common::DefinedIo::ReadUnformatted
|
|
: common::DefinedIo::WriteUnformatted)}) {
|
|
if (definedIo->subroutine) {
|
|
typeInfo::SpecialBinding special{DIR == Direction::Input
|
|
? typeInfo::SpecialBinding::Which::ReadUnformatted
|
|
: typeInfo::SpecialBinding::Which::WriteUnformatted,
|
|
definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
|
|
false};
|
|
if (Fortran::common::optional<bool> wasDefined{
|
|
DefinedUnformattedIo(io, descriptor, *type, special)}) {
|
|
return *wasDefined;
|
|
}
|
|
} else {
|
|
return DefaultComponentwiseUnformattedIO<DIR>(
|
|
io, descriptor, *type, table);
|
|
}
|
|
}
|
|
}
|
|
if (const typeInfo::SpecialBinding *
|
|
special{type->FindSpecialBinding(DIR == Direction::Input
|
|
? typeInfo::SpecialBinding::Which::ReadUnformatted
|
|
: typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
|
|
if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) {
|
|
// defined derived type unformatted I/O
|
|
return DefinedUnformattedIo(io, descriptor, *type, *special);
|
|
}
|
|
}
|
|
// Default derived type unformatted I/O
|
|
// TODO: If no component at any level has defined READ or WRITE
|
|
// (as appropriate), the elements are contiguous, and no byte swapping
|
|
// is active, do a block transfer via the code below.
|
|
return DefaultComponentwiseUnformattedIO<DIR>(io, descriptor, *type, table);
|
|
} else {
|
|
// intrinsic type unformatted I/O
|
|
auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
|
|
auto *childUnf{io.get_if<ChildUnformattedIoStatementState<DIR>>()};
|
|
auto *inq{
|
|
DIR == Direction::Output ? io.get_if<InquireIOLengthState>() : nullptr};
|
|
RUNTIME_CHECK(handler, externalUnf || childUnf || inq);
|
|
std::size_t elementBytes{descriptor.ElementBytes()};
|
|
std::size_t numElements{descriptor.Elements()};
|
|
std::size_t swappingBytes{elementBytes};
|
|
if (auto maybeCatAndKind{descriptor.type().GetCategoryAndKind()}) {
|
|
// Byte swapping units can be smaller than elements, namely
|
|
// for COMPLEX and CHARACTER.
|
|
if (maybeCatAndKind->first == TypeCategory::Character) {
|
|
// swap each character position independently
|
|
swappingBytes = maybeCatAndKind->second; // kind
|
|
} else if (maybeCatAndKind->first == TypeCategory::Complex) {
|
|
// swap real and imaginary components independently
|
|
swappingBytes /= 2;
|
|
}
|
|
}
|
|
SubscriptValue subscripts[maxRank];
|
|
descriptor.GetLowerBounds(subscripts);
|
|
using CharType =
|
|
std::conditional_t<DIR == Direction::Output, const char, char>;
|
|
auto Transfer{[=](CharType &x, std::size_t totalBytes) -> bool {
|
|
if constexpr (DIR == Direction::Output) {
|
|
return externalUnf ? externalUnf->Emit(&x, totalBytes, swappingBytes)
|
|
: childUnf ? childUnf->Emit(&x, totalBytes, swappingBytes)
|
|
: inq->Emit(&x, totalBytes, swappingBytes);
|
|
} else {
|
|
return externalUnf ? externalUnf->Receive(&x, totalBytes, swappingBytes)
|
|
: childUnf->Receive(&x, totalBytes, swappingBytes);
|
|
}
|
|
}};
|
|
bool swapEndianness{externalUnf && externalUnf->unit().swapEndianness()};
|
|
if (!swapEndianness &&
|
|
descriptor.IsContiguous()) { // contiguous unformatted I/O
|
|
char &x{ExtractElement<char>(io, descriptor, subscripts)};
|
|
return Transfer(x, numElements * elementBytes);
|
|
} else { // non-contiguous or byte-swapped intrinsic type unformatted I/O
|
|
for (std::size_t j{0}; j < numElements; ++j) {
|
|
char &x{ExtractElement<char>(io, descriptor, subscripts)};
|
|
if (!Transfer(x, elementBytes)) {
|
|
return false;
|
|
}
|
|
if (!descriptor.IncrementSubscripts(subscripts) &&
|
|
j + 1 < numElements) {
|
|
handler.Crash("DescriptorIO: subscripts out of bounds");
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
}
|
|
}
|
|
|
|
template <Direction DIR>
|
|
static RT_API_ATTRS bool DescriptorIO(IoStatementState &io,
|
|
const Descriptor &descriptor, const NonTbpDefinedIoTable *table) {
|
|
IoErrorHandler &handler{io.GetIoErrorHandler()};
|
|
if (handler.InError()) {
|
|
return false;
|
|
}
|
|
if (!io.get_if<IoDirectionState<DIR>>()) {
|
|
handler.Crash("DescriptorIO() called for wrong I/O direction");
|
|
return false;
|
|
}
|
|
if constexpr (DIR == Direction::Input) {
|
|
if (!io.BeginReadingRecord()) {
|
|
return false;
|
|
}
|
|
}
|
|
if (!io.get_if<FormattedIoStatementState<DIR>>()) {
|
|
return UnformattedDescriptorIO<DIR>(io, descriptor, table);
|
|
}
|
|
if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
|
|
TypeCategory cat{catAndKind->first};
|
|
int kind{catAndKind->second};
|
|
switch (cat) {
|
|
case TypeCategory::Integer:
|
|
switch (kind) {
|
|
case 1:
|
|
return FormattedIntegerIO<1, DIR>(io, descriptor, true);
|
|
case 2:
|
|
return FormattedIntegerIO<2, DIR>(io, descriptor, true);
|
|
case 4:
|
|
return FormattedIntegerIO<4, DIR>(io, descriptor, true);
|
|
case 8:
|
|
return FormattedIntegerIO<8, DIR>(io, descriptor, true);
|
|
case 16:
|
|
return FormattedIntegerIO<16, DIR>(io, descriptor, true);
|
|
default:
|
|
handler.Crash(
|
|
"not yet implemented: INTEGER(KIND=%d) in formatted IO", kind);
|
|
return false;
|
|
}
|
|
case TypeCategory::Unsigned:
|
|
switch (kind) {
|
|
case 1:
|
|
return FormattedIntegerIO<1, DIR>(io, descriptor, false);
|
|
case 2:
|
|
return FormattedIntegerIO<2, DIR>(io, descriptor, false);
|
|
case 4:
|
|
return FormattedIntegerIO<4, DIR>(io, descriptor, false);
|
|
case 8:
|
|
return FormattedIntegerIO<8, DIR>(io, descriptor, false);
|
|
case 16:
|
|
return FormattedIntegerIO<16, DIR>(io, descriptor, false);
|
|
default:
|
|
handler.Crash(
|
|
"not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind);
|
|
return false;
|
|
}
|
|
case TypeCategory::Real:
|
|
switch (kind) {
|
|
case 2:
|
|
return FormattedRealIO<2, DIR>(io, descriptor);
|
|
case 3:
|
|
return FormattedRealIO<3, DIR>(io, descriptor);
|
|
case 4:
|
|
return FormattedRealIO<4, DIR>(io, descriptor);
|
|
case 8:
|
|
return FormattedRealIO<8, DIR>(io, descriptor);
|
|
case 10:
|
|
return FormattedRealIO<10, DIR>(io, descriptor);
|
|
// TODO: case double/double
|
|
case 16:
|
|
return FormattedRealIO<16, DIR>(io, descriptor);
|
|
default:
|
|
handler.Crash(
|
|
"not yet implemented: REAL(KIND=%d) in formatted IO", kind);
|
|
return false;
|
|
}
|
|
case TypeCategory::Complex:
|
|
switch (kind) {
|
|
case 2:
|
|
return FormattedComplexIO<2, DIR>(io, descriptor);
|
|
case 3:
|
|
return FormattedComplexIO<3, DIR>(io, descriptor);
|
|
case 4:
|
|
return FormattedComplexIO<4, DIR>(io, descriptor);
|
|
case 8:
|
|
return FormattedComplexIO<8, DIR>(io, descriptor);
|
|
case 10:
|
|
return FormattedComplexIO<10, DIR>(io, descriptor);
|
|
// TODO: case double/double
|
|
case 16:
|
|
return FormattedComplexIO<16, DIR>(io, descriptor);
|
|
default:
|
|
handler.Crash(
|
|
"not yet implemented: COMPLEX(KIND=%d) in formatted IO", kind);
|
|
return false;
|
|
}
|
|
case TypeCategory::Character:
|
|
switch (kind) {
|
|
case 1:
|
|
return FormattedCharacterIO<char, DIR>(io, descriptor);
|
|
case 2:
|
|
return FormattedCharacterIO<char16_t, DIR>(io, descriptor);
|
|
case 4:
|
|
return FormattedCharacterIO<char32_t, DIR>(io, descriptor);
|
|
default:
|
|
handler.Crash(
|
|
"not yet implemented: CHARACTER(KIND=%d) in formatted IO", kind);
|
|
return false;
|
|
}
|
|
case TypeCategory::Logical:
|
|
switch (kind) {
|
|
case 1:
|
|
return FormattedLogicalIO<1, DIR>(io, descriptor);
|
|
case 2:
|
|
return FormattedLogicalIO<2, DIR>(io, descriptor);
|
|
case 4:
|
|
return FormattedLogicalIO<4, DIR>(io, descriptor);
|
|
case 8:
|
|
return FormattedLogicalIO<8, DIR>(io, descriptor);
|
|
default:
|
|
handler.Crash(
|
|
"not yet implemented: LOGICAL(KIND=%d) in formatted IO", kind);
|
|
return false;
|
|
}
|
|
case TypeCategory::Derived:
|
|
return FormattedDerivedTypeIO<DIR>(io, descriptor, table);
|
|
}
|
|
}
|
|
handler.Crash("DescriptorIO: bad type code (%d) in descriptor",
|
|
static_cast<int>(descriptor.type().raw()));
|
|
return false;
|
|
}
|
|
} // namespace Fortran::runtime::io::descr
|
|
#endif // FLANG_RT_RUNTIME_DESCRIPTOR_IO_H_
|