xref: /llvm-project/flang/runtime/edit-input.cpp (revision 7463b46a34efedbc3a72d05721886284e80b5cce)

//===-- runtime/edit-input.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 "edit-input.h"
#include "namelist.h"
#include "utf.h"
#include "flang/Common/optional.h"
#include "flang/Common/real.h"
#include "flang/Common/uint128.h"
#include "flang/Runtime/freestanding-tools.h"
#include <algorithm>
#include <cfenv>

namespace Fortran::runtime::io {
RT_OFFLOAD_API_GROUP_BEGIN

// Checks that a list-directed input value has been entirely consumed and
// doesn't contain unparsed characters before the next value separator.
static inline RT_API_ATTRS bool IsCharValueSeparator(
    const DataEdit &edit, char32_t ch) {
  char32_t comma{
      edit.modes.editingFlags & decimalComma ? char32_t{';'} : char32_t{','}};
  return ch == ' ' || ch == '\t' || ch == comma || ch == '/' ||
      (edit.IsNamelist() && (ch == '&' || ch == '$'));
}

static RT_API_ATTRS bool CheckCompleteListDirectedField(
    IoStatementState &io, const DataEdit &edit) {
  if (edit.IsListDirected()) {
    std::size_t byteCount;
    if (auto ch{io.GetCurrentChar(byteCount)}) {
      if (IsCharValueSeparator(edit, *ch)) {
        return true;
      } else {
        const auto &connection{io.GetConnectionState()};
        io.GetIoErrorHandler().SignalError(IostatBadListDirectedInputSeparator,
            "invalid character (0x%x) after list-directed input value, "
            "at column %d in record %d",
            static_cast<unsigned>(*ch),
            static_cast<int>(connection.positionInRecord + 1),
            static_cast<int>(connection.currentRecordNumber));
        return false;
      }
    } else {
      return true; // end of record: ok
    }
  } else {
    return true;
  }
}

static inline RT_API_ATTRS char32_t GetSeparatorChar(const DataEdit &edit) {
  return edit.modes.editingFlags & decimalComma ? char32_t{';'} : char32_t{','};
}

template <int LOG2_BASE>
static RT_API_ATTRS bool EditBOZInput(
    IoStatementState &io, const DataEdit &edit, void *n, std::size_t bytes) {
  // Skip leading white space & zeroes
  Fortran::common::optional<int> remaining{io.CueUpInput(edit)};
  auto start{io.GetConnectionState().positionInRecord};
  Fortran::common::optional<char32_t> next{io.NextInField(remaining, edit)};
  if (next.value_or('?') == '0') {
    do {
      start = io.GetConnectionState().positionInRecord;
      next = io.NextInField(remaining, edit);
    } while (next && *next == '0');
  }
  // Count significant digits after any leading white space & zeroes
  int digits{0};
  int significantBits{0};
  const char32_t comma{GetSeparatorChar(edit)};
  for (; next; next = io.NextInField(remaining, edit)) {
    char32_t ch{*next};
    if (ch == ' ' || ch == '\t') {
      if (edit.modes.editingFlags & blankZero) {
        ch = '0'; // BZ mode - treat blank as if it were zero
      } else {
        continue;
      }
    }
    if (ch >= '0' && ch <= '1') {
    } else if (LOG2_BASE >= 3 && ch >= '2' && ch <= '7') {
    } else if (LOG2_BASE >= 4 && ch >= '8' && ch <= '9') {
    } else if (LOG2_BASE >= 4 && ch >= 'A' && ch <= 'F') {
    } else if (LOG2_BASE >= 4 && ch >= 'a' && ch <= 'f') {
    } else if (ch == comma) {
      break; // end non-list-directed field early
    } else {
      io.GetIoErrorHandler().SignalError(
          "Bad character '%lc' in B/O/Z input field", ch);
      return false;
    }
    if (digits++ == 0) {
      if (ch >= '0' && ch <= '1') {
        significantBits = 1;
      } else if (ch >= '2' && ch <= '3') {
        significantBits = 2;
      } else if (ch >= '4' && ch <= '7') {
        significantBits = 3;
      } else {
        significantBits = 4;
      }
    } else {
      significantBits += LOG2_BASE;
    }
  }
  auto significantBytes{static_cast<std::size_t>(significantBits + 7) / 8};
  if (significantBytes > bytes) {
    io.GetIoErrorHandler().SignalError(IostatBOZInputOverflow,
        "B/O/Z input of %d digits overflows %zd-byte variable", digits, bytes);
    return false;
  }
  // Reset to start of significant digits
  io.HandleAbsolutePosition(start);
  remaining.reset();
  // Make a second pass now that the digit count is known
  std::memset(n, 0, bytes);
  int increment{isHostLittleEndian ? -1 : 1};
  auto *data{reinterpret_cast<unsigned char *>(n) +
      (isHostLittleEndian ? significantBytes - 1 : bytes - significantBytes)};
  int bitsAfterFirstDigit{(digits - 1) * LOG2_BASE};
  int shift{bitsAfterFirstDigit & 7};
  if (shift + (significantBits - bitsAfterFirstDigit) > 8) {
    shift = shift - 8; // misaligned octal
  }
  while (digits > 0) {
    char32_t ch{io.NextInField(remaining, edit).value_or(' ')};
    int digit{0};
    if (ch == ' ' || ch == '\t') {
      if (edit.modes.editingFlags & blankZero) {
        ch = '0'; // BZ mode - treat blank as if it were zero
      } else {
        continue;
      }
    }
    --digits;
    if (ch >= '0' && ch <= '9') {
      digit = ch - '0';
    } else if (ch >= 'A' && ch <= 'F') {
      digit = ch + 10 - 'A';
    } else if (ch >= 'a' && ch <= 'f') {
      digit = ch + 10 - 'a';
    } else {
      continue;
    }
    if (shift < 0) {
      if (shift + LOG2_BASE > 0) { // misaligned octal
        *data |= digit >> -shift;
      }
      shift += 8;
      data += increment;
    }
    *data |= digit << shift;
    shift -= LOG2_BASE;
  }
  return CheckCompleteListDirectedField(io, edit);
}

static inline RT_API_ATTRS char32_t GetRadixPointChar(const DataEdit &edit) {
  return edit.modes.editingFlags & decimalComma ? char32_t{','} : char32_t{'.'};
}

// Prepares input from a field, and returns the sign, if any, else '\0'.
static RT_API_ATTRS char ScanNumericPrefix(IoStatementState &io,
    const DataEdit &edit, Fortran::common::optional<char32_t> &next,
    Fortran::common::optional<int> &remaining) {
  remaining = io.CueUpInput(edit);
  next = io.NextInField(remaining, edit);
  char sign{'\0'};
  if (next) {
    if (*next == '-' || *next == '+') {
      sign = *next;
      if (!edit.IsListDirected()) {
        io.SkipSpaces(remaining);
      }
      next = io.NextInField(remaining, edit);
    }
  }
  return sign;
}

RT_API_ATTRS bool EditIntegerInput(IoStatementState &io, const DataEdit &edit,
    void *n, int kind, bool isSigned) {
  RUNTIME_CHECK(io.GetIoErrorHandler(), kind >= 1 && !(kind & (kind - 1)));
  switch (edit.descriptor) {
  case DataEdit::ListDirected:
    if (IsNamelistNameOrSlash(io)) {
      return false;
    }
    break;
  case 'G':
  case 'I':
    break;
  case 'B':
    return EditBOZInput<1>(io, edit, n, kind);
  case 'O':
    return EditBOZInput<3>(io, edit, n, kind);
  case 'Z':
    return EditBOZInput<4>(io, edit, n, kind);
  case 'A': // legacy extension
    return EditCharacterInput(io, edit, reinterpret_cast<char *>(n), kind);
  default:
    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
        "Data edit descriptor '%c' may not be used with an INTEGER data item",
        edit.descriptor);
    return false;
  }
  Fortran::common::optional<int> remaining;
  Fortran::common::optional<char32_t> next;
  char sign{ScanNumericPrefix(io, edit, next, remaining)};
  if (sign == '-' && !isSigned) {
    io.GetIoErrorHandler().SignalError("Negative sign in UNSIGNED input field");
    return false;
  }
  common::UnsignedInt128 value{0};
  bool any{!!sign};
  bool overflow{false};
  const char32_t comma{GetSeparatorChar(edit)};
  static constexpr auto maxu128{~common::UnsignedInt128{0}};
  for (; next; next = io.NextInField(remaining, edit)) {
    char32_t ch{*next};
    if (ch == ' ' || ch == '\t') {
      if (edit.modes.editingFlags & blankZero) {
        ch = '0'; // BZ mode - treat blank as if it were zero
      } else {
        continue;
      }
    }
    int digit{0};
    if (ch >= '0' && ch <= '9') {
      digit = ch - '0';
    } else if (ch == comma) {
      break; // end non-list-directed field early
    } else {
      if (edit.modes.inNamelist && ch == GetRadixPointChar(edit)) {
        // Ignore any fractional part that might appear in NAMELIST integer
        // input, like a few other Fortran compilers do.
        // TODO: also process exponents?  Some compilers do, but they obviously
        // can't just be ignored.
        while ((next = io.NextInField(remaining, edit))) {
          if (*next < '0' || *next > '9') {
            break;
          }
        }
        if (!next || *next == comma) {
          break;
        }
      }
      io.GetIoErrorHandler().SignalError(
          "Bad character '%lc' in INTEGER input field", ch);
      return false;
    }
    static constexpr auto maxu128OverTen{maxu128 / 10};
    static constexpr int maxLastDigit{
        static_cast<int>(maxu128 - (maxu128OverTen * 10))};
    overflow |= value >= maxu128OverTen &&
        (value > maxu128OverTen || digit > maxLastDigit);
    value *= 10;
    value += digit;
    any = true;
  }
  if (!any && !remaining) {
    io.GetIoErrorHandler().SignalError(
        "Integer value absent from NAMELIST or list-directed input");
    return false;
  }
  if (isSigned) {
    auto maxForKind{common::UnsignedInt128{1} << ((8 * kind) - 1)};
    overflow |= value >= maxForKind && (value > maxForKind || sign != '-');
  } else {
    auto maxForKind{maxu128 >> (((16 - kind) * 8) + (isSigned ? 1 : 0))};
    overflow |= value >= maxForKind;
  }
  if (overflow) {
    io.GetIoErrorHandler().SignalError(IostatIntegerInputOverflow,
        "Decimal input overflows INTEGER(%d) variable", kind);
    return false;
  }
  if (sign == '-') {
    value = -value;
  }
  if (any || !io.GetIoErrorHandler().InError()) {
    // The value is stored in the lower order bits on big endian platform.
    // When memcpy, shift the value to the higher order bit.
    auto shft{static_cast<int>(sizeof(value.low())) - kind};
    // For kind==8 (i.e. shft==0), the value is stored in low_ in big endian.
    if (!isHostLittleEndian && shft >= 0) {
      auto l{value.low() << (8 * shft)};
      std::memcpy(n, &l, kind);
    } else {
      std::memcpy(n, &value, kind); // a blank field means zero
    }
    return true;
  } else {
    return false;
  }
}

// Parses a REAL input number from the input source as a normalized
// fraction into a supplied buffer -- there's an optional '-', a
// decimal point when the input is not hexadecimal, and at least one
// digit.  Replaces blanks with zeroes where appropriate.
struct ScannedRealInput {
  // Number of characters that (should) have been written to the
  // buffer -- this can be larger than the buffer size, which
  // indicates buffer overflow.  Zero indicates an error.
  int got{0};
  int exponent{0}; // adjusted as necessary; binary if isHexadecimal
  bool isHexadecimal{false}; // 0X...
};
static RT_API_ATTRS ScannedRealInput ScanRealInput(
    char *buffer, int bufferSize, IoStatementState &io, const DataEdit &edit) {
  Fortran::common::optional<int> remaining;
  Fortran::common::optional<char32_t> next;
  int got{0};
  Fortran::common::optional<int> radixPointOffset;
  // The following lambda definition violates the conding style,
  // but cuda-11.8 nvcc hits an internal error with the brace initialization.
  auto Put = [&](char ch) -> void {
    if (got < bufferSize) {
      buffer[got] = ch;
    }
    ++got;
  };
  char sign{ScanNumericPrefix(io, edit, next, remaining)};
  if (sign == '-') {
    Put('-');
  }
  bool bzMode{(edit.modes.editingFlags & blankZero) != 0};
  int exponent{0};
  if (!next || (!bzMode && *next == ' ') ||
      (!(edit.modes.editingFlags & decimalComma) && *next == ',')) {
    if (!edit.IsListDirected() && !io.GetConnectionState().IsAtEOF()) {
      // An empty/blank field means zero when not list-directed.
      // A fixed-width field containing only a sign is also zero;
      // this behavior isn't standard-conforming in F'2023 but it is
      // required to pass FCVS.
      Put('0');
    }
    return {got, exponent, false};
  }
  char32_t radixPointChar{GetRadixPointChar(edit)};
  char32_t first{*next >= 'a' && *next <= 'z' ? *next + 'A' - 'a' : *next};
  bool isHexadecimal{false};
  if (first == 'N' || first == 'I') {
    // NaN or infinity - convert to upper case
    // Subtle: a blank field of digits could be followed by 'E' or 'D',
    for (; next &&
         ((*next >= 'a' && *next <= 'z') || (*next >= 'A' && *next <= 'Z'));
         next = io.NextInField(remaining, edit)) {
      if (*next >= 'a' && *next <= 'z') {
        Put(*next - 'a' + 'A');
      } else {
        Put(*next);
      }
    }
    if (next && *next == '(') { // NaN(...)
      Put('(');
      int depth{1};
      while (true) {
        next = io.NextInField(remaining, edit);
        if (depth == 0) {
          break;
        } else if (!next) {
          return {}; // error
        } else if (*next == '(') {
          ++depth;
        } else if (*next == ')') {
          --depth;
        }
        Put(*next);
      }
    }
  } else if (first == radixPointChar || (first >= '0' && first <= '9') ||
      (bzMode && (first == ' ' || first == '\t')) || first == 'E' ||
      first == 'D' || first == 'Q') {
    if (first == '0') {
      next = io.NextInField(remaining, edit);
      if (next && (*next == 'x' || *next == 'X')) { // 0X...
        isHexadecimal = true;
        next = io.NextInField(remaining, edit);
      } else {
        Put('0');
      }
    }
    // input field is normalized to a fraction
    if (!isHexadecimal) {
      Put('.');
    }
    auto start{got};
    for (; next; next = io.NextInField(remaining, edit)) {
      char32_t ch{*next};
      if (ch == ' ' || ch == '\t') {
        if (isHexadecimal) {
          return {}; // error
        } else if (bzMode) {
          ch = '0'; // BZ mode - treat blank as if it were zero
        } else {
          continue; // ignore blank in fixed field
        }
      }
      if (ch == '0' && got == start && !radixPointOffset) {
        // omit leading zeroes before the radix point
      } else if (ch >= '0' && ch <= '9') {
        Put(ch);
      } else if (ch == radixPointChar && !radixPointOffset) {
        // The radix point character is *not* copied to the buffer.
        radixPointOffset = got - start; // # of digits before the radix point
      } else if (isHexadecimal && ch >= 'A' && ch <= 'F') {
        Put(ch);
      } else if (isHexadecimal && ch >= 'a' && ch <= 'f') {
        Put(ch - 'a' + 'A'); // normalize to capitals
      } else {
        break;
      }
    }
    if (got == start) {
      // Nothing but zeroes and maybe a radix point.  F'2018 requires
      // at least one digit, but F'77 did not, and a bare "." shows up in
      // the FCVS suite.
      Put('0'); // emit at least one digit
    }
    // In list-directed input, a bad exponent is not consumed.
    auto nextBeforeExponent{next};
    auto startExponent{io.GetConnectionState().positionInRecord};
    bool hasGoodExponent{false};
    if (next) {
      if (isHexadecimal) {
        if (*next == 'p' || *next == 'P') {
          next = io.NextInField(remaining, edit);
        } else {
          // The binary exponent is not optional in the standard.
          return {}; // error
        }
      } else if (*next == 'e' || *next == 'E' || *next == 'd' || *next == 'D' ||
          *next == 'q' || *next == 'Q') {
        // Optional exponent letter.  Blanks are allowed between the
        // optional exponent letter and the exponent value.
        io.SkipSpaces(remaining);
        next = io.NextInField(remaining, edit);
      }
    }
    if (next &&
        (*next == '-' || *next == '+' || (*next >= '0' && *next <= '9') ||
            *next == ' ' || *next == '\t')) {
      bool negExpo{*next == '-'};
      if (negExpo || *next == '+') {
        next = io.NextInField(remaining, edit);
      }
      for (; next; next = io.NextInField(remaining, edit)) {
        if (*next >= '0' && *next <= '9') {
          hasGoodExponent = true;
          if (exponent < 10000) {
            exponent = 10 * exponent + *next - '0';
          }
        } else if (*next == ' ' || *next == '\t') {
          if (isHexadecimal) {
            break;
          } else if (bzMode) {
            hasGoodExponent = true;
            exponent = 10 * exponent;
          }
        } else {
          break;
        }
      }
      if (negExpo) {
        exponent = -exponent;
      }
    }
    if (!hasGoodExponent) {
      if (isHexadecimal) {
        return {}; // error
      }
      // There isn't a good exponent; do not consume it.
      next = nextBeforeExponent;
      io.HandleAbsolutePosition(startExponent);
      // The default exponent is -kP, but the scale factor doesn't affect
      // an explicit exponent.
      exponent = -edit.modes.scale;
    }
    // Adjust exponent by number of digits before the radix point.
    if (isHexadecimal) {
      // Exponents for hexadecimal input are binary.
      exponent += radixPointOffset.value_or(got - start) * 4;
    } else if (radixPointOffset) {
      exponent += *radixPointOffset;
    } else {
      // When no redix point (or comma) appears in the value, the 'd'
      // part of the edit descriptor must be interpreted as the number of
      // digits in the value to be interpreted as being to the *right* of
      // the assumed radix point (13.7.2.3.2)
      exponent += got - start - edit.digits.value_or(0);
    }
  }
  // Consume the trailing ')' of a list-directed or NAMELIST complex
  // input value.
  if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
    if (next && (*next == ' ' || *next == '\t')) {
      io.SkipSpaces(remaining);
      next = io.NextInField(remaining, edit);
    }
    if (!next) { // NextInField fails on separators like ')'
      std::size_t byteCount{0};
      next = io.GetCurrentChar(byteCount);
      if (next && *next == ')') {
        io.HandleRelativePosition(byteCount);
      }
    }
  } else if (remaining) {
    while (next && (*next == ' ' || *next == '\t')) {
      next = io.NextInField(remaining, edit);
    }
    if (next && (*next != ',' || (edit.modes.editingFlags & decimalComma))) {
      return {}; // error: unused nonblank character in fixed-width field
    }
  }
  return {got, exponent, isHexadecimal};
}

static RT_API_ATTRS void RaiseFPExceptions(
    decimal::ConversionResultFlags flags) {
#undef RAISE
#if defined(RT_DEVICE_COMPILATION)
  Terminator terminator(__FILE__, __LINE__);
#define RAISE(e) \
  terminator.Crash( \
      "not implemented yet: raising FP exception in device code: %s", #e);
#else // !defined(RT_DEVICE_COMPILATION)
#ifdef feraisexcept // a macro in some environments; omit std::
#define RAISE feraiseexcept
#else
#define RAISE std::feraiseexcept
#endif
#endif // !defined(RT_DEVICE_COMPILATION)

// Some environment (e.g. emscripten, musl) don't define FE_OVERFLOW as allowed
// by c99 (but not c++11) :-/
#if defined(FE_OVERFLOW) || defined(RT_DEVICE_COMPILATION)
  if (flags & decimal::ConversionResultFlags::Overflow) {
    RAISE(FE_OVERFLOW);
  }
#endif
#if defined(FE_UNDERFLOW) || defined(RT_DEVICE_COMPILATION)
  if (flags & decimal::ConversionResultFlags::Underflow) {
    RAISE(FE_UNDERFLOW);
  }
#endif
#if defined(FE_INEXACT) || defined(RT_DEVICE_COMPILATION)
  if (flags & decimal::ConversionResultFlags::Inexact) {
    RAISE(FE_INEXACT);
  }
#endif
#if defined(FE_INVALID) || defined(RT_DEVICE_COMPILATION)
  if (flags & decimal::ConversionResultFlags::Invalid) {
    RAISE(FE_INVALID);
  }
#endif
#undef RAISE
}

// If no special modes are in effect and the form of the input value
// that's present in the input stream is acceptable to the decimal->binary
// converter without modification, this fast path for real input
// saves time by avoiding memory copies and reformatting of the exponent.
template <int PRECISION>
static RT_API_ATTRS bool TryFastPathRealDecimalInput(
    IoStatementState &io, const DataEdit &edit, void *n) {
  if (edit.modes.editingFlags & (blankZero | decimalComma)) {
    return false;
  }
  if (edit.modes.scale != 0) {
    return false;
  }
  const ConnectionState &connection{io.GetConnectionState()};
  if (connection.internalIoCharKind > 1) {
    return false; // reading non-default character
  }
  const char *str{nullptr};
  std::size_t got{io.GetNextInputBytes(str)};
  if (got == 0 || str == nullptr || !connection.recordLength.has_value()) {
    return false; // could not access reliably-terminated input stream
  }
  const char *p{str};
  std::int64_t maxConsume{
      std::min<std::int64_t>(got, edit.width.value_or(got))};
  const char *limit{str + maxConsume};
  decimal::ConversionToBinaryResult<PRECISION> converted{
      decimal::ConvertToBinary<PRECISION>(p, edit.modes.round, limit)};
  if (converted.flags & (decimal::Invalid | decimal::Overflow)) {
    return false;
  }
  if (edit.digits.value_or(0) != 0) {
    // Edit descriptor is Fw.d (or other) with d != 0, which
    // implies scaling
    const char *q{str};
    for (; q < limit; ++q) {
      if (*q == '.' || *q == 'n' || *q == 'N') {
        break;
      }
    }
    if (q == limit) {
      // No explicit decimal point, and not NaN/Inf.
      return false;
    }
  }
  if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
    // Need to consume a trailing ')', possibly with leading spaces
    for (; p < limit && (*p == ' ' || *p == '\t'); ++p) {
    }
    if (p < limit && *p == ')') {
      ++p;
    } else {
      return false;
    }
  } else if (edit.IsListDirected()) {
    if (p < limit && !IsCharValueSeparator(edit, *p)) {
      return false;
    }
  } else {
    for (; p < limit && (*p == ' ' || *p == '\t'); ++p) {
    }
    if (edit.width && p < str + *edit.width) {
      return false; // unconverted characters remain in fixed width field
    }
  }
  // Success on the fast path!
  *reinterpret_cast<decimal::BinaryFloatingPointNumber<PRECISION> *>(n) =
      converted.binary;
  io.HandleRelativePosition(p - str);
  // Set FP exception flags
  if (converted.flags != decimal::ConversionResultFlags::Exact) {
    RaiseFPExceptions(converted.flags);
  }
  return true;
}

template <int binaryPrecision>
RT_API_ATTRS decimal::ConversionToBinaryResult<binaryPrecision>
ConvertHexadecimal(
    const char *&p, enum decimal::FortranRounding rounding, int expo) {
  using RealType = decimal::BinaryFloatingPointNumber<binaryPrecision>;
  using RawType = typename RealType::RawType;
  bool isNegative{*p == '-'};
  constexpr RawType one{1};
  RawType signBit{0};
  if (isNegative) {
    ++p;
    signBit = one << (RealType::bits - 1);
  }
  RawType fraction{0};
  // Adjust the incoming binary P+/- exponent to shift the radix point
  // to below the LSB and add in the bias.
  expo += binaryPrecision - 1 + RealType::exponentBias;
  // Input the fraction.
  int roundingBit{0};
  int guardBit{0};
  for (; *p; ++p) {
    fraction <<= 4;
    expo -= 4;
    if (*p >= '0' && *p <= '9') {
      fraction |= *p - '0';
    } else if (*p >= 'A' && *p <= 'F') {
      fraction |= *p - 'A' + 10; // data were normalized to capitals
    } else {
      break;
    }
    if (fraction >> binaryPrecision) {
      while (fraction >> binaryPrecision) {
        guardBit |= roundingBit;
        roundingBit = (int)fraction & 1;
        fraction >>= 1;
        ++expo;
      }
      // Consume excess digits
      while (*++p) {
        if (*p == '0') {
        } else if ((*p >= '1' && *p <= '9') || (*p >= 'A' && *p <= 'F')) {
          guardBit = 1;
        } else {
          break;
        }
      }
      break;
    }
  }
  if (fraction) {
    // Boost biased expo if too small
    while (expo < 1) {
      guardBit |= roundingBit;
      roundingBit = (int)fraction & 1;
      fraction >>= 1;
      ++expo;
    }
    // Normalize
    while (expo > 1 && !(fraction >> (binaryPrecision - 1))) {
      fraction <<= 1;
      --expo;
      guardBit = roundingBit = 0;
    }
  }
  // Rounding
  bool increase{false};
  switch (rounding) {
  case decimal::RoundNearest: // RN & RP
    increase = roundingBit && (guardBit | ((int)fraction & 1));
    break;
  case decimal::RoundUp: // RU
    increase = !isNegative && (roundingBit | guardBit);
    break;
  case decimal::RoundDown: // RD
    increase = isNegative && (roundingBit | guardBit);
    break;
  case decimal::RoundToZero: // RZ
    break;
  case decimal::RoundCompatible: // RC
    increase = roundingBit != 0;
    break;
  }
  if (increase) {
    ++fraction;
    if (fraction >> binaryPrecision) {
      fraction >>= 1;
      ++expo;
    }
  }
  // Package & return result
  constexpr RawType significandMask{(one << RealType::significandBits) - 1};
  int flags{(roundingBit | guardBit) ? decimal::Inexact : decimal::Exact};
  if (!fraction) {
    expo = 0;
  } else if (expo == 1 && !(fraction >> (binaryPrecision - 1))) {
    expo = 0; // subnormal
    flags |= decimal::Underflow;
  } else if (expo >= RealType::maxExponent) {
    if (rounding == decimal::RoundToZero ||
        (rounding == decimal::RoundDown && !isNegative) ||
        (rounding == decimal::RoundUp && isNegative)) {
      expo = RealType::maxExponent - 1; // +/-HUGE()
      fraction = significandMask;
    } else {
      expo = RealType::maxExponent; // +/-Inf
      fraction = 0;
      flags |= decimal::Overflow;
    }
  } else {
    fraction &= significandMask; // remove explicit normalization unless x87
  }
  return decimal::ConversionToBinaryResult<binaryPrecision>{
      RealType{static_cast<RawType>(signBit |
          static_cast<RawType>(expo) << RealType::significandBits | fraction)},
      static_cast<decimal::ConversionResultFlags>(flags)};
}

template <int KIND>
RT_API_ATTRS bool EditCommonRealInput(
    IoStatementState &io, const DataEdit &edit, void *n) {
  constexpr int binaryPrecision{common::PrecisionOfRealKind(KIND)};
  if (TryFastPathRealDecimalInput<binaryPrecision>(io, edit, n)) {
    return CheckCompleteListDirectedField(io, edit);
  }
  // Fast path wasn't available or didn't work; go the more general route
  static constexpr int maxDigits{
      common::MaxDecimalConversionDigits(binaryPrecision)};
  static constexpr int bufferSize{maxDigits + 18};
  char buffer[bufferSize];
  auto scanned{ScanRealInput(buffer, maxDigits + 2, io, edit)};
  int got{scanned.got};
  if (got >= maxDigits + 2) {
    io.GetIoErrorHandler().Crash("EditCommonRealInput: buffer was too small");
    return false;
  }
  if (got == 0) {
    const auto &connection{io.GetConnectionState()};
    io.GetIoErrorHandler().SignalError(IostatBadRealInput,
        "Bad real input data at column %d of record %d",
        static_cast<int>(connection.positionInRecord + 1),
        static_cast<int>(connection.currentRecordNumber));
    return false;
  }
  decimal::ConversionToBinaryResult<binaryPrecision> converted;
  const char *p{buffer};
  if (scanned.isHexadecimal) {
    buffer[got] = '\0';
    converted = ConvertHexadecimal<binaryPrecision>(
        p, edit.modes.round, scanned.exponent);
  } else {
    bool hadExtra{got > maxDigits};
    int exponent{scanned.exponent};
    if (exponent != 0) {
      buffer[got++] = 'e';
      if (exponent < 0) {
        buffer[got++] = '-';
        exponent = -exponent;
      }
      if (exponent > 9999) {
        exponent = 9999; // will convert to +/-Inf
      }
      if (exponent > 999) {
        int dig{exponent / 1000};
        buffer[got++] = '0' + dig;
        int rest{exponent - 1000 * dig};
        dig = rest / 100;
        buffer[got++] = '0' + dig;
        rest -= 100 * dig;
        dig = rest / 10;
        buffer[got++] = '0' + dig;
        buffer[got++] = '0' + (rest - 10 * dig);
      } else if (exponent > 99) {
        int dig{exponent / 100};
        buffer[got++] = '0' + dig;
        int rest{exponent - 100 * dig};
        dig = rest / 10;
        buffer[got++] = '0' + dig;
        buffer[got++] = '0' + (rest - 10 * dig);
      } else if (exponent > 9) {
        int dig{exponent / 10};
        buffer[got++] = '0' + dig;
        buffer[got++] = '0' + (exponent - 10 * dig);
      } else {
        buffer[got++] = '0' + exponent;
      }
    }
    buffer[got] = '\0';
    converted = decimal::ConvertToBinary<binaryPrecision>(p, edit.modes.round);
    if (hadExtra) {
      converted.flags = static_cast<enum decimal::ConversionResultFlags>(
          converted.flags | decimal::Inexact);
    }
  }
  if (*p) { // unprocessed junk after value
    const auto &connection{io.GetConnectionState()};
    io.GetIoErrorHandler().SignalError(IostatBadRealInput,
        "Trailing characters after real input data at column %d of record %d",
        static_cast<int>(connection.positionInRecord + 1),
        static_cast<int>(connection.currentRecordNumber));
    return false;
  }
  *reinterpret_cast<decimal::BinaryFloatingPointNumber<binaryPrecision> *>(n) =
      converted.binary;
  // Set FP exception flags
  if (converted.flags != decimal::ConversionResultFlags::Exact) {
    if (converted.flags & decimal::ConversionResultFlags::Overflow) {
      io.GetIoErrorHandler().SignalError(IostatRealInputOverflow);
      return false;
    }
    RaiseFPExceptions(converted.flags);
  }
  return CheckCompleteListDirectedField(io, edit);
}

template <int KIND>
RT_API_ATTRS bool EditRealInput(
    IoStatementState &io, const DataEdit &edit, void *n) {
  switch (edit.descriptor) {
  case DataEdit::ListDirected:
    if (IsNamelistNameOrSlash(io)) {
      return false;
    }
    return EditCommonRealInput<KIND>(io, edit, n);
  case DataEdit::ListDirectedRealPart:
  case DataEdit::ListDirectedImaginaryPart:
  case 'F':
  case 'E': // incl. EN, ES, & EX
  case 'D':
  case 'G':
    return EditCommonRealInput<KIND>(io, edit, n);
  case 'B':
    return EditBOZInput<1>(io, edit, n,
        common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
  case 'O':
    return EditBOZInput<3>(io, edit, n,
        common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
  case 'Z':
    return EditBOZInput<4>(io, edit, n,
        common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
  case 'A': // legacy extension
    return EditCharacterInput(io, edit, reinterpret_cast<char *>(n), KIND);
  default:
    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
        "Data edit descriptor '%c' may not be used for REAL input",
        edit.descriptor);
    return false;
  }
}

// 13.7.3 in Fortran 2018
RT_API_ATTRS bool EditLogicalInput(
    IoStatementState &io, const DataEdit &edit, bool &x) {
  switch (edit.descriptor) {
  case DataEdit::ListDirected:
    if (IsNamelistNameOrSlash(io)) {
      return false;
    }
    break;
  case 'L':
  case 'G':
    break;
  default:
    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
        "Data edit descriptor '%c' may not be used for LOGICAL input",
        edit.descriptor);
    return false;
  }
  Fortran::common::optional<int> remaining{io.CueUpInput(edit)};
  Fortran::common::optional<char32_t> next{io.NextInField(remaining, edit)};
  if (next && *next == '.') { // skip optional period
    next = io.NextInField(remaining, edit);
  }
  if (!next) {
    io.GetIoErrorHandler().SignalError("Empty LOGICAL input field");
    return false;
  }
  switch (*next) {
  case 'T':
  case 't':
    x = true;
    break;
  case 'F':
  case 'f':
    x = false;
    break;
  default:
    io.GetIoErrorHandler().SignalError(
        "Bad character '%lc' in LOGICAL input field", *next);
    return false;
  }
  if (remaining) { // ignore the rest of a fixed-width field
    io.HandleRelativePosition(*remaining);
  } else if (edit.descriptor == DataEdit::ListDirected) {
    while (io.NextInField(remaining, edit)) { // discard rest of field
    }
  }
  return CheckCompleteListDirectedField(io, edit);
}

// See 13.10.3.1 paragraphs 7-9 in Fortran 2018
template <typename CHAR>
static RT_API_ATTRS bool EditDelimitedCharacterInput(
    IoStatementState &io, CHAR *x, std::size_t length, char32_t delimiter) {
  bool result{true};
  while (true) {
    std::size_t byteCount{0};
    auto ch{io.GetCurrentChar(byteCount)};
    if (!ch) {
      if (io.AdvanceRecord()) {
        continue;
      } else {
        result = false; // EOF in character value
        break;
      }
    }
    io.HandleRelativePosition(byteCount);
    if (*ch == delimiter) {
      auto next{io.GetCurrentChar(byteCount)};
      if (next && *next == delimiter) {
        // Repeated delimiter: use as character value
        io.HandleRelativePosition(byteCount);
      } else {
        break; // closing delimiter
      }
    }
    if (length > 0) {
      *x++ = *ch;
      --length;
    }
  }
  Fortran::runtime::fill_n(x, length, ' ');
  return result;
}

template <typename CHAR>
static RT_API_ATTRS bool EditListDirectedCharacterInput(
    IoStatementState &io, CHAR *x, std::size_t length, const DataEdit &edit) {
  std::size_t byteCount{0};
  auto ch{io.GetCurrentChar(byteCount)};
  if (ch && (*ch == '\'' || *ch == '"')) {
    io.HandleRelativePosition(byteCount);
    return EditDelimitedCharacterInput(io, x, length, *ch);
  }
  if (IsNamelistNameOrSlash(io) || io.GetConnectionState().IsAtEOF()) {
    return false;
  }
  // Undelimited list-directed character input: stop at a value separator
  // or the end of the current record.
  while (auto ch{io.GetCurrentChar(byteCount)}) {
    bool isSep{false};
    switch (*ch) {
    case ' ':
    case '\t':
    case '/':
      isSep = true;
      break;
    case '&':
    case '$':
      isSep = edit.IsNamelist();
      break;
    case ',':
      isSep = !(edit.modes.editingFlags & decimalComma);
      break;
    case ';':
      isSep = !!(edit.modes.editingFlags & decimalComma);
      break;
    default:
      break;
    }
    if (isSep) {
      break;
    }
    if (length > 0) {
      *x++ = *ch;
      --length;
    } else if (edit.IsNamelist()) {
      // GNU compatibility
      break;
    }
    io.HandleRelativePosition(byteCount);
    io.GotChar(byteCount);
  }
  Fortran::runtime::fill_n(x, length, ' ');
  return true;
}

template <typename CHAR>
RT_API_ATTRS bool EditCharacterInput(IoStatementState &io, const DataEdit &edit,
    CHAR *x, std::size_t lengthChars) {
  switch (edit.descriptor) {
  case DataEdit::ListDirected:
    return EditListDirectedCharacterInput(io, x, lengthChars, edit);
  case 'A':
  case 'G':
    break;
  case 'B':
    return EditBOZInput<1>(io, edit, x, lengthChars * sizeof *x);
  case 'O':
    return EditBOZInput<3>(io, edit, x, lengthChars * sizeof *x);
  case 'Z':
    return EditBOZInput<4>(io, edit, x, lengthChars * sizeof *x);
  default:
    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
        "Data edit descriptor '%c' may not be used with a CHARACTER data item",
        edit.descriptor);
    return false;
  }
  const ConnectionState &connection{io.GetConnectionState()};
  std::size_t remainingChars{lengthChars};
  // Skip leading characters.
  // Their bytes don't count towards INQUIRE(IOLENGTH=).
  std::size_t skipChars{0};
  if (edit.width && *edit.width > 0) {
    remainingChars = *edit.width;
    if (remainingChars > lengthChars) {
      skipChars = remainingChars - lengthChars;
    }
  }
  // When the field is wider than the variable, we drop the leading
  // characters.  When the variable is wider than the field, there can be
  // trailing padding or an EOR condition.
  const char *input{nullptr};
  std::size_t readyBytes{0};
  // Transfer payload bytes; these do count.
  while (remainingChars > 0) {
    if (readyBytes == 0) {
      readyBytes = io.GetNextInputBytes(input);
      if (readyBytes == 0 ||
          (readyBytes < remainingChars && edit.modes.nonAdvancing)) {
        if (io.CheckForEndOfRecord(readyBytes)) {
          if (readyBytes == 0) {
            // PAD='YES' and no more data
            Fortran::runtime::fill_n(x, lengthChars, ' ');
            return !io.GetIoErrorHandler().InError();
          } else {
            // Do partial read(s) then pad on last iteration
          }
        } else {
          return !io.GetIoErrorHandler().InError();
        }
      }
    }
    std::size_t chunkBytes;
    std::size_t chunkChars{1};
    bool skipping{skipChars > 0};
    if (connection.isUTF8) {
      chunkBytes = MeasureUTF8Bytes(*input);
      if (skipping) {
        --skipChars;
      } else if (auto ucs{DecodeUTF8(input)}) {
        if ((sizeof *x == 1 && *ucs > 0xff) ||
            (sizeof *x == 2 && *ucs > 0xffff)) {
          *x++ = '?';
        } else {
          *x++ = *ucs;
        }
        --lengthChars;
      } else if (chunkBytes == 0) {
        // error recovery: skip bad encoding
        chunkBytes = 1;
      }
    } else if (connection.internalIoCharKind > 1) {
      // Reading from non-default character internal unit
      chunkBytes = connection.internalIoCharKind;
      if (skipping) {
        --skipChars;
      } else {
        char32_t buffer{0};
        std::memcpy(&buffer, input, chunkBytes);
        if ((sizeof *x == 1 && buffer > 0xff) ||
            (sizeof *x == 2 && buffer > 0xffff)) {
          *x++ = '?';
        } else {
          *x++ = buffer;
        }
        --lengthChars;
      }
    } else if constexpr (sizeof *x > 1) {
      // Read single byte with expansion into multi-byte CHARACTER
      chunkBytes = 1;
      if (skipping) {
        --skipChars;
      } else {
        *x++ = static_cast<unsigned char>(*input);
        --lengthChars;
      }
    } else { // single bytes -> default CHARACTER
      if (skipping) {
        chunkBytes = std::min<std::size_t>(skipChars, readyBytes);
        chunkChars = chunkBytes;
        skipChars -= chunkChars;
      } else {
        chunkBytes = std::min<std::size_t>(remainingChars, readyBytes);
        chunkBytes = std::min<std::size_t>(lengthChars, chunkBytes);
        chunkChars = chunkBytes;
        std::memcpy(x, input, chunkBytes);
        x += chunkBytes;
        lengthChars -= chunkChars;
      }
    }
    input += chunkBytes;
    remainingChars -= chunkChars;
    if (!skipping) {
      io.GotChar(chunkBytes);
    }
    io.HandleRelativePosition(chunkBytes);
    readyBytes -= chunkBytes;
  }
  // Pad the remainder of the input variable, if any.
  Fortran::runtime::fill_n(x, lengthChars, ' ');
  return CheckCompleteListDirectedField(io, edit);
}

template RT_API_ATTRS bool EditRealInput<2>(
    IoStatementState &, const DataEdit &, void *);
template RT_API_ATTRS bool EditRealInput<3>(
    IoStatementState &, const DataEdit &, void *);
template RT_API_ATTRS bool EditRealInput<4>(
    IoStatementState &, const DataEdit &, void *);
template RT_API_ATTRS bool EditRealInput<8>(
    IoStatementState &, const DataEdit &, void *);
template RT_API_ATTRS bool EditRealInput<10>(
    IoStatementState &, const DataEdit &, void *);
// TODO: double/double
template RT_API_ATTRS bool EditRealInput<16>(
    IoStatementState &, const DataEdit &, void *);

template RT_API_ATTRS bool EditCharacterInput(
    IoStatementState &, const DataEdit &, char *, std::size_t);
template RT_API_ATTRS bool EditCharacterInput(
    IoStatementState &, const DataEdit &, char16_t *, std::size_t);
template RT_API_ATTRS bool EditCharacterInput(
    IoStatementState &, const DataEdit &, char32_t *, std::size_t);

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