//===-- lib/runtime/descriptor-io.cpp ---------------------------*- 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
//
//===----------------------------------------------------------------------===//

#include "descriptor-io.h"
#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-rt/runtime/work-queue.h"
#include "flang/Common/optional.h"
#include "flang/Common/restorer.h"
#include "flang/Common/uint128.h"
#include "flang/Runtime/cpp-type.h"
#include "flang/Runtime/freestanding-tools.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.)

namespace Fortran::runtime::io::descr {
RT_OFFLOAD_API_GROUP_BEGIN

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;
}

// Defined formatted I/O (maybe)
static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
    IoStatementState &io, const Descriptor &descriptor,
    const typeInfo::DerivedType &derived,
    const typeInfo::SpecialBinding &special,
    const SubscriptValue subscripts[]) {
  Fortran::common::optional<DataEdit> peek{
      io.GetNextDataEdit(0 /*to peek at it*/)};
  if (peek &&
      (peek->descriptor == DataEdit::DefinedDerivedType ||
          peek->descriptor == DataEdit::ListDirected)) {
    // Defined formatting
    IoErrorHandler &handler{io.GetIoErrorHandler()};
    DataEdit edit{*io.GetNextDataEdit(1)}; // now consume it; no repeats
    RUNTIME_CHECK(handler, edit.descriptor == peek->descriptor);
    char ioType[2 + edit.maxIoTypeChars];
    auto ioTypeLen{std::size_t{2} /*"DT"*/ + edit.ioTypeChars};
    if (edit.descriptor == DataEdit::DefinedDerivedType) {
      ioType[0] = 'D';
      ioType[1] = 'T';
      std::memcpy(ioType + 2, edit.ioType, edit.ioTypeChars);
    } else {
      runtime::strcpy(
          ioType, io.mutableModes().inNamelist ? "NAMELIST" : "LISTDIRECTED");
      ioTypeLen = runtime::strlen(ioType);
    }
    StaticDescriptor<1, true> vListStatDesc;
    Descriptor &vListDesc{vListStatDesc.descriptor()};
    vListDesc.Establish(TypeCategory::Integer, sizeof(int), nullptr, 1);
    vListDesc.set_base_addr(edit.vList);
    vListDesc.GetDimension(0).SetBounds(1, edit.vListEntries);
    vListDesc.GetDimension(0).SetByteStride(
        static_cast<SubscriptValue>(sizeof(int)));
    ExternalFileUnit *actualExternal{io.GetExternalFileUnit()};
    ExternalFileUnit *external{actualExternal};
    if (!external) {
      // Create a new unit to service defined I/O for an
      // internal I/O parent.
      external = &ExternalFileUnit::NewUnit(handler, true);
    }
    ChildIo &child{external->PushChildIo(io)};
    // Child formatted I/O is nonadvancing by definition (F'2018 12.6.2.4).
    auto restorer{common::ScopedSet(io.mutableModes().nonAdvancing, true)};
    int unit{external->unitNumber()};
    int ioStat{IostatOk};
    char ioMsg[100];
    Fortran::common::optional<std::int64_t> startPos;
    if (edit.descriptor == DataEdit::DefinedDerivedType &&
        special.which() == typeInfo::SpecialBinding::Which::ReadFormatted) {
      // DT is an edit descriptor so everything that the child
      // I/O subroutine reads counts towards READ(SIZE=).
      startPos = io.InquirePos();
    }
    if (special.IsArgDescriptor(0)) {
      // "dtv" argument is "class(t)", pass a descriptor
      auto *p{special.GetProc<void (*)(const Descriptor &, int &, char *,
          const Descriptor &, int &, char *, std::size_t, std::size_t)>()};
      StaticDescriptor<1, true, 10 /*?*/> elementStatDesc;
      Descriptor &elementDesc{elementStatDesc.descriptor()};
      elementDesc.Establish(
          derived, nullptr, 0, nullptr, CFI_attribute_pointer);
      elementDesc.set_base_addr(descriptor.Element<char>(subscripts));
      p(elementDesc, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,
          sizeof ioMsg);
    } else {
      // "dtv" argument is "type(t)", pass a raw pointer
      auto *p{special.GetProc<void (*)(const void *, int &, char *,
          const Descriptor &, int &, char *, std::size_t, std::size_t)>()};
      p(descriptor.Element<char>(subscripts), unit, ioType, vListDesc, ioStat,
          ioMsg, ioTypeLen, sizeof ioMsg);
    }
    handler.Forward(ioStat, ioMsg, sizeof ioMsg);
    external->PopChildIo(child);
    if (!actualExternal) {
      // Close unit created for internal I/O above.
      auto *closing{external->LookUpForClose(external->unitNumber())};
      RUNTIME_CHECK(handler, external == closing);
      external->DestroyClosed();
    }
    if (startPos) {
      io.GotChar(io.InquirePos() - *startPos);
    }
    return handler.GetIoStat() == IostatOk;
  } else {
    // There's a defined I/O subroutine, but there's a FORMAT present and
    // it does not have a DT data edit descriptor, so apply default formatting
    // to the components of the derived type as usual.
    return Fortran::common::nullopt;
  }
}

// Defined unformatted I/O
static RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &io,
    const Descriptor &descriptor, const typeInfo::DerivedType &derived,
    const typeInfo::SpecialBinding &special) {
  // Unformatted I/O must have an external unit (or child thereof).
  IoErrorHandler &handler{io.GetIoErrorHandler()};
  ExternalFileUnit *external{io.GetExternalFileUnit()};
  if (!external) { // INQUIRE(IOLENGTH=)
    handler.SignalError(IostatNonExternalDefinedUnformattedIo);
    return false;
  }
  ChildIo &child{external->PushChildIo(io)};
  int unit{external->unitNumber()};
  int ioStat{IostatOk};
  char ioMsg[100];
  std::size_t numElements{descriptor.Elements()};
  SubscriptValue subscripts[maxRank];
  descriptor.GetLowerBounds(subscripts);
  if (special.IsArgDescriptor(0)) {
    // "dtv" argument is "class(t)", pass a descriptor
    auto *p{special.GetProc<void (*)(
        const Descriptor &, int &, int &, char *, std::size_t)>()};
    StaticDescriptor<1, true, 10 /*?*/> elementStatDesc;
    Descriptor &elementDesc{elementStatDesc.descriptor()};
    elementDesc.Establish(derived, nullptr, 0, nullptr, CFI_attribute_pointer);
    for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {
      elementDesc.set_base_addr(descriptor.Element<char>(subscripts));
      p(elementDesc, unit, ioStat, ioMsg, sizeof ioMsg);
      if (ioStat != IostatOk) {
        break;
      }
    }
  } else {
    // "dtv" argument is "type(t)", pass a raw pointer
    auto *p{special.GetProc<void (*)(
        const void *, int &, int &, char *, std::size_t)>()};
    for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {
      p(descriptor.Element<char>(subscripts), unit, ioStat, ioMsg,
          sizeof ioMsg);
      if (ioStat != IostatOk) {
        break;
      }
    }
  }
  handler.Forward(ioStat, ioMsg, sizeof ioMsg);
  external->PopChildIo(child);
  return handler.GetIoStat() == IostatOk;
}

// 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>
RT_API_ATTRS int DerivedIoTicket<DIR>::Continue(WorkQueue &workQueue) {
  while (!IsComplete()) {
    if (component_->genre() == typeInfo::Component::Genre::Data) {
      // Create a descriptor for the component
      Descriptor &compDesc{componentDescriptor_.descriptor()};
      component_->CreatePointerDescriptor(
          compDesc, instance_, io_.GetIoErrorHandler(), subscripts_);
      Advance();
      if (int status{workQueue.BeginDescriptorIo<DIR>(
              io_, compDesc, table_, anyIoTookPlace_)};
          status != StatOk) {
        return status;
      }
    } else {
      // Component is itself a descriptor
      char *pointer{
          instance_.Element<char>(subscripts_) + component_->offset()};
      const Descriptor &compDesc{
          *reinterpret_cast<const Descriptor *>(pointer)};
      Advance();
      if (compDesc.IsAllocated()) {
        if (int status{workQueue.BeginDescriptorIo<DIR>(
                io_, compDesc, table_, anyIoTookPlace_)};
            status != StatOk) {
          return status;
        }
      }
    }
  }
  return StatOk;
}

template RT_API_ATTRS int DerivedIoTicket<Direction::Output>::Continue(
    WorkQueue &);
template RT_API_ATTRS int DerivedIoTicket<Direction::Input>::Continue(
    WorkQueue &);

template <Direction DIR>
RT_API_ATTRS int DescriptorIoTicket<DIR>::Begin(WorkQueue &workQueue) {
  IoErrorHandler &handler{io_.GetIoErrorHandler()};
  if (handler.InError()) {
    return handler.GetIoStat();
  }
  if (!io_.get_if<IoDirectionState<DIR>>()) {
    handler.Crash("DescriptorIO() called for wrong I/O direction");
    return handler.GetIoStat();
  }
  if constexpr (DIR == Direction::Input) {
    if (!io_.BeginReadingRecord()) {
      return StatOk;
    }
  }
  if (!io_.get_if<FormattedIoStatementState<DIR>>()) {
    // Unformatted I/O
    IoErrorHandler &handler{io_.GetIoErrorHandler()};
    const DescriptorAddendum *addendum{instance_.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 (DefinedUnformattedIo(io_, instance_, *type, special)) {
              anyIoTookPlace_ = true;
              return StatOk;
            }
          } else {
            int status{workQueue.BeginDerivedIo<DIR>(
                io_, instance_, *type, table_, anyIoTookPlace_)};
            return status == StatContinue ? StatOk : status; // done here
          }
        }
      }
      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
          if (DefinedUnformattedIo(io_, instance_, *type, *special)) {
            anyIoTookPlace_ = true;
            return StatOk;
          } else {
            return IostatEnd;
          }
        }
      }
      // 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.
      int status{workQueue.BeginDerivedIo<DIR>(
          io_, instance_, *type, table_, anyIoTookPlace_)};
      return status == StatContinue ? StatOk : status; // done here
    } else {
      // intrinsic type unformatted I/O
      auto *externalUnf{io_.get_if<ExternalUnformattedIoStatementState<DIR>>()};
      ChildUnformattedIoStatementState<DIR> *childUnf{nullptr};
      InquireIOLengthState *inq{nullptr};
      bool swapEndianness{false};
      if (externalUnf) {
        swapEndianness = externalUnf->unit().swapEndianness();
      } else {
        childUnf = io_.get_if<ChildUnformattedIoStatementState<DIR>>();
        if (!childUnf) {
          inq = DIR == Direction::Output ? io_.get_if<InquireIOLengthState>()
                                         : nullptr;
          RUNTIME_CHECK(handler, inq != nullptr);
        }
      }
      std::size_t elementBytes{instance_.ElementBytes()};
      std::size_t swappingBytes{elementBytes};
      if (auto maybeCatAndKind{instance_.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;
        }
      }
      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);
        }
      }};
      if (!swapEndianness &&
          instance_.IsContiguous()) { // contiguous unformatted I/O
        char &x{ExtractElement<char>(io_, instance_, subscripts_)};
        if (Transfer(x, elements_ * elementBytes)) {
          anyIoTookPlace_ = true;
        } else {
          return IostatEnd;
        }
      } else { // non-contiguous or byte-swapped intrinsic type unformatted I/O
        for (; !IsComplete(); Advance()) {
          char &x{ExtractElement<char>(io_, instance_, subscripts_)};
          if (Transfer(x, elementBytes)) {
            anyIoTookPlace_ = true;
          } else {
            return IostatEnd;
          }
        }
      }
    }
    // Unformatted I/O never needs to call Continue().
    return StatOk;
  }
  // Formatted I/O
  if (auto catAndKind{instance_.type().GetCategoryAndKind()}) {
    TypeCategory cat{catAndKind->first};
    int kind{catAndKind->second};
    bool any{false};
    switch (cat) {
    case TypeCategory::Integer:
      switch (kind) {
      case 1:
        any = FormattedIntegerIO<1, DIR>(io_, instance_, true);
        break;
      case 2:
        any = FormattedIntegerIO<2, DIR>(io_, instance_, true);
        break;
      case 4:
        any = FormattedIntegerIO<4, DIR>(io_, instance_, true);
        break;
      case 8:
        any = FormattedIntegerIO<8, DIR>(io_, instance_, true);
        break;
      case 16:
        any = FormattedIntegerIO<16, DIR>(io_, instance_, true);
        break;
      default:
        handler.Crash(
            "not yet implemented: INTEGER(KIND=%d) in formatted IO", kind);
        return IostatEnd;
      }
      break;
    case TypeCategory::Unsigned:
      switch (kind) {
      case 1:
        any = FormattedIntegerIO<1, DIR>(io_, instance_, false);
        break;
      case 2:
        any = FormattedIntegerIO<2, DIR>(io_, instance_, false);
        break;
      case 4:
        any = FormattedIntegerIO<4, DIR>(io_, instance_, false);
        break;
      case 8:
        any = FormattedIntegerIO<8, DIR>(io_, instance_, false);
        break;
      case 16:
        any = FormattedIntegerIO<16, DIR>(io_, instance_, false);
        break;
      default:
        handler.Crash(
            "not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind);
        return IostatEnd;
      }
      break;
    case TypeCategory::Real:
      switch (kind) {
      case 2:
        any = FormattedRealIO<2, DIR>(io_, instance_);
        break;
      case 3:
        any = FormattedRealIO<3, DIR>(io_, instance_);
        break;
      case 4:
        any = FormattedRealIO<4, DIR>(io_, instance_);
        break;
      case 8:
        any = FormattedRealIO<8, DIR>(io_, instance_);
        break;
      case 10:
        any = FormattedRealIO<10, DIR>(io_, instance_);
        break;
      // TODO: case double/double
      case 16:
        any = FormattedRealIO<16, DIR>(io_, instance_);
        break;
      default:
        handler.Crash(
            "not yet implemented: REAL(KIND=%d) in formatted IO", kind);
        return IostatEnd;
      }
      break;
    case TypeCategory::Complex:
      switch (kind) {
      case 2:
        any = FormattedComplexIO<2, DIR>(io_, instance_);
        break;
      case 3:
        any = FormattedComplexIO<3, DIR>(io_, instance_);
        break;
      case 4:
        any = FormattedComplexIO<4, DIR>(io_, instance_);
        break;
      case 8:
        any = FormattedComplexIO<8, DIR>(io_, instance_);
        break;
      case 10:
        any = FormattedComplexIO<10, DIR>(io_, instance_);
        break;
      // TODO: case double/double
      case 16:
        any = FormattedComplexIO<16, DIR>(io_, instance_);
        break;
      default:
        handler.Crash(
            "not yet implemented: COMPLEX(KIND=%d) in formatted IO", kind);
        return IostatEnd;
      }
      break;
    case TypeCategory::Character:
      switch (kind) {
      case 1:
        any = FormattedCharacterIO<char, DIR>(io_, instance_);
        break;
      case 2:
        any = FormattedCharacterIO<char16_t, DIR>(io_, instance_);
        break;
      case 4:
        any = FormattedCharacterIO<char32_t, DIR>(io_, instance_);
        break;
      default:
        handler.Crash(
            "not yet implemented: CHARACTER(KIND=%d) in formatted IO", kind);
        return IostatEnd;
      }
      break;
    case TypeCategory::Logical:
      switch (kind) {
      case 1:
        any = FormattedLogicalIO<1, DIR>(io_, instance_);
        break;
      case 2:
        any = FormattedLogicalIO<2, DIR>(io_, instance_);
        break;
      case 4:
        any = FormattedLogicalIO<4, DIR>(io_, instance_);
        break;
      case 8:
        any = FormattedLogicalIO<8, DIR>(io_, instance_);
        break;
      default:
        handler.Crash(
            "not yet implemented: LOGICAL(KIND=%d) in formatted IO", kind);
        return IostatEnd;
      }
      break;
    case TypeCategory::Derived: {
      // Derived type information must be present for formatted I/O.
      IoErrorHandler &handler{io_.GetIoErrorHandler()};
      const DescriptorAddendum *addendum{instance_.Addendum()};
      RUNTIME_CHECK(handler, addendum != nullptr);
      derived_ = addendum->derivedType();
      RUNTIME_CHECK(handler, derived_ != nullptr);
      if (table_) {
        if (const auto *definedIo{table_->Find(*derived_,
                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{
                derived_->FindSpecialBinding(DIR == Direction::Input
                        ? typeInfo::SpecialBinding::Which::ReadFormatted
                        : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
          if (!table_ || !table_->ignoreNonTbpEntries ||
              binding->isTypeBound()) {
            special_ = binding;
          }
        }
      }
      return StatContinue;
    }
    }
    if (any) {
      anyIoTookPlace_ = true;
    } else {
      return IostatEnd;
    }
  } else {
    handler.Crash("DescriptorIO: bad type code (%d) in descriptor",
        static_cast<int>(instance_.type().raw()));
    return handler.GetIoStat();
  }
  return StatOk;
}

template RT_API_ATTRS int DescriptorIoTicket<Direction::Output>::Begin(
    WorkQueue &);
template RT_API_ATTRS int DescriptorIoTicket<Direction::Input>::Begin(
    WorkQueue &);

template <Direction DIR>
RT_API_ATTRS int DescriptorIoTicket<DIR>::Continue(WorkQueue &workQueue) {
  // Only derived type formatted I/O gets here.
  while (!IsComplete()) {
    if (special_) {
      if (auto defined{DefinedFormattedIo(
              io_, instance_, *derived_, *special_, subscripts_)}) {
        anyIoTookPlace_ |= *defined;
        Advance();
        continue;
      }
    }
    Descriptor &elementDesc{elementDescriptor_.descriptor()};
    elementDesc.Establish(
        *derived_, nullptr, 0, nullptr, CFI_attribute_pointer);
    elementDesc.set_base_addr(instance_.Element<char>(subscripts_));
    Advance();
    if (int status{workQueue.BeginDerivedIo<DIR>(
            io_, elementDesc, *derived_, table_, anyIoTookPlace_)};
        status != StatOk) {
      return status;
    }
  }
  return StatOk;
}

template RT_API_ATTRS int DescriptorIoTicket<Direction::Output>::Continue(
    WorkQueue &);
template RT_API_ATTRS int DescriptorIoTicket<Direction::Input>::Continue(
    WorkQueue &);

template <Direction DIR>
RT_API_ATTRS bool DescriptorIO(IoStatementState &io,
    const Descriptor &descriptor, const NonTbpDefinedIoTable *table) {
  bool anyIoTookPlace{false};
  WorkQueue workQueue{io.GetIoErrorHandler()};
  if (workQueue.BeginDescriptorIo<DIR>(io, descriptor, table, anyIoTookPlace) ==
      StatContinue) {
    workQueue.Run();
  }
  return anyIoTookPlace;
}

template RT_API_ATTRS bool DescriptorIO<Direction::Output>(
    IoStatementState &, const Descriptor &, const NonTbpDefinedIoTable *);
template RT_API_ATTRS bool DescriptorIO<Direction::Input>(
    IoStatementState &, const Descriptor &, const NonTbpDefinedIoTable *);

RT_OFFLOAD_API_GROUP_END
} // namespace Fortran::runtime::io::descr