flang/runtime/edit-output.cpp

   1 //===-- runtime/edit-output.cpp -------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "edit-output.h"
  10 #include "emit-encoded.h"
  11 #include "utf.h"
  12 #include "flang/Common/real.h"
  13 #include "flang/Common/uint128.h"
  14 #include <algorithm>
  15
  16 namespace Fortran::runtime::io {
  17 RT_OFFLOAD_API_GROUP_BEGIN
  18
  19 // In output statement, add a space between numbers and characters.
  20 static RT_API_ATTRS void addSpaceBeforeCharacter(IoStatementState &io) {
  21   if (auto *list{io.get_if<ListDirectedStatementState<Direction::Output>>()}) {
  22     list->set_lastWasUndelimitedCharacter(false);
  23   }
  24 }
  25
  26 // B/O/Z output of arbitrarily sized data emits a binary/octal/hexadecimal
  27 // representation of what is interpreted to be a single unsigned integer value.
  28 // When used with character data, endianness is exposed.
  29 template <int LOG2_BASE>
  30 static RT_API_ATTRS bool EditBOZOutput(IoStatementState &io,
  31     const DataEdit &edit, const unsigned char *data0, std::size_t bytes) {
  32   addSpaceBeforeCharacter(io);
  33   int digits{static_cast<int>((bytes * 8) / LOG2_BASE)};
  34   int get{static_cast<int>(bytes * 8) - digits * LOG2_BASE};
  35   if (get > 0) {
  36     ++digits;
  37   } else {
  38     get = LOG2_BASE;
  39   }
  40   int shift{7};
  41   int increment{isHostLittleEndian ? -1 : 1};
  42   const unsigned char *data{data0 + (isHostLittleEndian ? bytes - 1 : 0)};
  43   int skippedZeroes{0};
  44   int digit{0};
  45   // The same algorithm is used to generate digits for real (below)
  46   // as well as for generating them only to skip leading zeroes (here).
  47   // Bits are copied one at a time from the source data.
  48   // TODO: Multiple bit copies for hexadecimal, where misalignment
  49   // is not possible; or for octal when all 3 bits come from the
  50   // same byte.
  51   while (bytes > 0) {
  52     if (get == 0) {
  53       if (digit != 0) {
  54         break; // first nonzero leading digit
  55       }
  56       ++skippedZeroes;
  57       get = LOG2_BASE;
  58     } else if (shift < 0) {
  59       data += increment;
  60       --bytes;
  61       shift = 7;
  62     } else {
  63       digit = 2 * digit + ((*data >> shift--) & 1);
  64       --get;
  65     }
  66   }
  67   // Emit leading spaces and zeroes; detect field overflow
  68   int leadingZeroes{0};
  69   int editWidth{edit.width.value_or(0)};
  70   int significant{digits - skippedZeroes};
  71   if (edit.digits && significant <= *edit.digits) { // Bw.m, Ow.m, Zw.m
  72     if (*edit.digits == 0 && bytes == 0) {
  73       editWidth = std::max(1, editWidth);
  74     } else {
  75       leadingZeroes = *edit.digits - significant;
  76     }
  77   } else if (bytes == 0) {
  78     leadingZeroes = 1;
  79   }
  80   int subTotal{leadingZeroes + significant};
  81   int leadingSpaces{std::max(0, editWidth - subTotal)};
  82   if (editWidth > 0 && leadingSpaces + subTotal > editWidth) {
  83     return EmitRepeated(io, '*', editWidth);
  84   }
  85   if (!(EmitRepeated(io, ' ', leadingSpaces) &&
  86           EmitRepeated(io, '0', leadingZeroes))) {
  87     return false;
  88   }
  89   // Emit remaining digits
  90   while (bytes > 0) {
  91     if (get == 0) {
  92       char ch{static_cast<char>(digit >= 10 ? 'A' + digit - 10 : '0' + digit)};
  93       if (!EmitAscii(io, &ch, 1)) {
  94         return false;
  95       }
  96       get = LOG2_BASE;
  97       digit = 0;
  98     } else if (shift < 0) {
  99       data += increment;
 100       --bytes;
 101       shift = 7;
 102     } else {
 103       digit = 2 * digit + ((*data >> shift--) & 1);
 104       --get;
 105     }
 106   }
 107   return true;
 108 }
 109
 110 template <int KIND>
 111 bool RT_API_ATTRS EditIntegerOutput(IoStatementState &io, const DataEdit &edit,
 112     common::HostSignedIntType<8 * KIND> n) {
 113   addSpaceBeforeCharacter(io);
 114   char buffer[130], *end{&buffer[sizeof buffer]}, *p{end};
 115   bool isNegative{n < 0};
 116   using Unsigned = common::HostUnsignedIntType<8 * KIND>;
 117   Unsigned un{static_cast<Unsigned>(n)};
 118   int signChars{0};
 119   switch (edit.descriptor) {
 120   case DataEdit::ListDirected:
 121   case 'G':
 122   case 'I':
 123     if (isNegative) {
 124       un = -un;
 125     }
 126     if (isNegative || (edit.modes.editingFlags & signPlus)) {
 127       signChars = 1; // '-' or '+'
 128     }
 129     while (un > 0) {
 130       auto quotient{un / 10u};
 131       *--p = '0' + static_cast<int>(un - Unsigned{10} * quotient);
 132       un = quotient;
 133     }
 134     break;
 135   case 'B':
 136     return EditBOZOutput<1>(
 137         io, edit, reinterpret_cast<const unsigned char *>(&n), KIND);
 138   case 'O':
 139     return EditBOZOutput<3>(
 140         io, edit, reinterpret_cast<const unsigned char *>(&n), KIND);
 141   case 'Z':
 142     return EditBOZOutput<4>(
 143         io, edit, reinterpret_cast<const unsigned char *>(&n), KIND);
 144   case 'L':
 145     return EditLogicalOutput(io, edit, n != 0 ? true : false);
 146   case 'A': // legacy extension
 147     return EditCharacterOutput(
 148         io, edit, reinterpret_cast<char *>(&n), sizeof n);
 149   default:
 150     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
 151         "Data edit descriptor '%c' may not be used with an INTEGER data item",
 152         edit.descriptor);
 153     return false;
 154   }
 155
 156   int digits = end - p;
 157   int leadingZeroes{0};
 158   int editWidth{edit.width.value_or(0)};
 159   if (edit.descriptor == 'I' && edit.digits && digits <= *edit.digits) {
 160     // Only Iw.m can produce leading zeroes, not Gw.d (F'202X 13.7.5.2.2)
 161     if (*edit.digits == 0 && n == 0) {
 162       // Iw.0 with zero value: output field must be blank.  For I0.0
 163       // and a zero value, emit one blank character.
 164       signChars = 0; // in case of SP
 165       editWidth = std::max(1, editWidth);
 166     } else {
 167       leadingZeroes = *edit.digits - digits;
 168     }
 169   } else if (n == 0) {
 170     leadingZeroes = 1;
 171   }
 172   int subTotal{signChars + leadingZeroes + digits};
 173   int leadingSpaces{std::max(0, editWidth - subTotal)};
 174   if (editWidth > 0 && leadingSpaces + subTotal > editWidth) {
 175     return EmitRepeated(io, '*', editWidth);
 176   }
 177   if (edit.IsListDirected()) {
 178     int total{std::max(leadingSpaces, 1) + subTotal};
 179     if (io.GetConnectionState().NeedAdvance(static_cast<std::size_t>(total)) &&
 180         !io.AdvanceRecord()) {
 181       return false;
 182     }
 183     leadingSpaces = 1;
 184   }
 185   return EmitRepeated(io, ' ', leadingSpaces) &&
 186       EmitAscii(io, n < 0 ? "-" : "+", signChars) &&
 187       EmitRepeated(io, '0', leadingZeroes) && EmitAscii(io, p, digits);
 188 }
 189
 190 // Formats the exponent (see table 13.1 for all the cases)
 191 RT_API_ATTRS const char *RealOutputEditingBase::FormatExponent(
 192     int expo, const DataEdit &edit, int &length) {
 193   char *eEnd{&exponent_[sizeof exponent_]};
 194   char *exponent{eEnd};
 195   for (unsigned e{static_cast<unsigned>(std::abs(expo))}; e > 0;) {
 196     unsigned quotient{e / 10u};
 197     *--exponent = '0' + e - 10 * quotient;
 198     e = quotient;
 199   }
 200   bool overflow{false};
 201   if (edit.expoDigits) {
 202     if (int ed{*edit.expoDigits}) { // Ew.dEe with e > 0
 203       overflow = exponent + ed < eEnd;
 204       while (exponent > exponent_ + 2 /*E+*/ && exponent + ed > eEnd) {
 205         *--exponent = '0';
 206       }
 207     } else if (exponent == eEnd) {
 208       *--exponent = '0'; // Ew.dE0 with zero-valued exponent
 209     }
 210   } else if (edit.variation == 'X') {
 211     if (expo == 0) {
 212       *--exponent = '0'; // EX without Ee and zero-valued exponent
 213     }
 214   } else {
 215     // Ensure at least two exponent digits unless EX
 216     while (exponent + 2 > eEnd) {
 217       *--exponent = '0';
 218     }
 219   }
 220   *--exponent = expo < 0 ? '-' : '+';
 221   if (edit.variation == 'X') {
 222     *--exponent = 'P';
 223   } else if (edit.expoDigits || edit.IsListDirected() || exponent + 3 == eEnd) {
 224     *--exponent = edit.descriptor == 'D' ? 'D' : 'E'; // not 'G' or 'Q'
 225   }
 226   length = eEnd - exponent;
 227   return overflow ? nullptr : exponent;
 228 }
 229
 230 RT_API_ATTRS bool RealOutputEditingBase::EmitPrefix(
 231     const DataEdit &edit, std::size_t length, std::size_t width) {
 232   if (edit.IsListDirected()) {
 233     int prefixLength{edit.descriptor == DataEdit::ListDirectedRealPart ? 2
 234             : edit.descriptor == DataEdit::ListDirectedImaginaryPart   ? 0
 235                                                                        : 1};
 236     int suffixLength{edit.descriptor == DataEdit::ListDirectedRealPart ||
 237                 edit.descriptor == DataEdit::ListDirectedImaginaryPart
 238             ? 1
 239             : 0};
 240     length += prefixLength + suffixLength;
 241     ConnectionState &connection{io_.GetConnectionState()};
 242     return (!connection.NeedAdvance(length) || io_.AdvanceRecord()) &&
 243         EmitAscii(io_, " (", prefixLength);
 244   } else if (width > length) {
 245     return EmitRepeated(io_, ' ', width - length);
 246   } else {
 247     return true;
 248   }
 249 }
 250
 251 RT_API_ATTRS bool RealOutputEditingBase::EmitSuffix(const DataEdit &edit) {
 252   if (edit.descriptor == DataEdit::ListDirectedRealPart) {
 253     return EmitAscii(
 254         io_, edit.modes.editingFlags & decimalComma ? ";" : ",", 1);
 255   } else if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
 256     return EmitAscii(io_, ")", 1);
 257   } else {
 258     return true;
 259   }
 260 }
 261
 262 template <int KIND>
 263 RT_API_ATTRS decimal::ConversionToDecimalResult
 264 RealOutputEditing<KIND>::ConvertToDecimal(
 265     int significantDigits, enum decimal::FortranRounding rounding, int flags) {
 266   auto converted{decimal::ConvertToDecimal<binaryPrecision>(buffer_,
 267       sizeof buffer_, static_cast<enum decimal::DecimalConversionFlags>(flags),
 268       significantDigits, rounding, x_)};
 269   if (!converted.str) { // overflow
 270     io_.GetIoErrorHandler().Crash(
 271         "RealOutputEditing::ConvertToDecimal: buffer size %zd was insufficient",
 272         sizeof buffer_);
 273   }
 274   return converted;
 275 }
 276
 277 static RT_API_ATTRS bool IsInfOrNaN(const char *p, int length) {
 278   if (!p || length < 1) {
 279     return false;
 280   }
 281   if (*p == '-' || *p == '+') {
 282     if (length == 1) {
 283       return false;
 284     }
 285     ++p;
 286   }
 287   return *p == 'I' || *p == 'N';
 288 }
 289
 290 // 13.7.2.3.3 in F'2018
 291 template <int KIND>
 292 RT_API_ATTRS bool RealOutputEditing<KIND>::EditEorDOutput(
 293     const DataEdit &edit) {
 294   addSpaceBeforeCharacter(io_);
 295   int editDigits{edit.digits.value_or(0)}; // 'd' field
 296   int editWidth{edit.width.value_or(0)}; // 'w' field
 297   int significantDigits{editDigits};
 298   int flags{0};
 299   if (edit.modes.editingFlags & signPlus) {
 300     flags |= decimal::AlwaysSign;
 301   }
 302   int scale{edit.modes.scale}; // 'kP' value
 303   bool isEN{edit.variation == 'N'};
 304   bool isES{edit.variation == 'S'};
 305   if (editWidth == 0) { // "the processor selects the field width"
 306     if (edit.digits.has_value()) { // E0.d
 307       if (editDigits == 0 && scale <= 0) { // E0.0
 308         significantDigits = isEN || isES ? 0 : 1;
 309       }
 310     } else { // E0
 311       flags |= decimal::Minimize;
 312       significantDigits =
 313           sizeof buffer_ - 5; // sign, NUL, + 3 extra for EN scaling
 314     }
 315   }
 316   int zeroesAfterPoint{0};
 317   if (isEN) {
 318     scale = IsZero() ? 1 : 3;
 319     significantDigits += scale;
 320   } else if (isES) {
 321     scale = 1;
 322     ++significantDigits;
 323   } else if (scale < 0) {
 324     if (scale <= -editDigits) {
 325       io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor,
 326           "Scale factor (kP) %d cannot be less than -d (%d)", scale,
 327           -editDigits);
 328       return false;
 329     }
 330     zeroesAfterPoint = -scale;
 331     significantDigits = std::max(0, significantDigits - zeroesAfterPoint);
 332   } else if (scale > 0) {
 333     if (scale >= editDigits + 2) {
 334       io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor,
 335           "Scale factor (kP) %d cannot be greater than d+2 (%d)", scale,
 336           editDigits + 2);
 337       return false;
 338     }
 339     ++significantDigits;
 340     scale = std::min(scale, significantDigits + 1);
 341   } else if (edit.digits.value_or(1) == 0 && !edit.variation) {
 342     // F'2023 13.7.2.3.3 p5; does not apply to Gw.0(Ee) or E0(no d)
 343     io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
 344         "Output edit descriptor %cw.d must have d>0", edit.descriptor);
 345     return false;
 346   }
 347   // In EN editing, multiple attempts may be necessary, so this is a loop.
 348   while (true) {
 349     decimal::ConversionToDecimalResult converted{
 350         ConvertToDecimal(significantDigits, edit.modes.round, flags)};
 351     if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
 352       return editWidth > 0 &&
 353               converted.length + trailingBlanks_ >
 354                   static_cast<std::size_t>(editWidth)
 355           ? EmitRepeated(io_, '*', editWidth)
 356           : EmitPrefix(edit, converted.length, editWidth) &&
 357               EmitAscii(io_, converted.str, converted.length) &&
 358               EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit);
 359     }
 360     if (!IsZero()) {
 361       converted.decimalExponent -= scale;
 362     }
 363     if (isEN) {
 364       // EN mode: we need an effective exponent field that is
 365       // a multiple of three.
 366       if (int modulus{converted.decimalExponent % 3}; modulus != 0) {
 367         if (significantDigits > 1) {
 368           --significantDigits;
 369           --scale;
 370           continue;
 371         }
 372         // Rounded nines up to a 1.
 373         scale += modulus;
 374         converted.decimalExponent -= modulus;
 375       }
 376       if (scale > 3) {
 377         int adjust{3 * (scale / 3)};
 378         scale -= adjust;
 379         converted.decimalExponent += adjust;
 380       } else if (scale < 1) {
 381         int adjust{3 - 3 * (scale / 3)};
 382         scale += adjust;
 383         converted.decimalExponent -= adjust;
 384       }
 385       significantDigits = editDigits + scale;
 386     }
 387     // Format the exponent (see table 13.1 for all the cases)
 388     int expoLength{0};
 389     const char *exponent{
 390         FormatExponent(converted.decimalExponent, edit, expoLength)};
 391     int signLength{*converted.str == '-' || *converted.str == '+' ? 1 : 0};
 392     int convertedDigits{static_cast<int>(converted.length) - signLength};
 393     int zeroesBeforePoint{std::max(0, scale - convertedDigits)};
 394     int digitsBeforePoint{std::max(0, scale - zeroesBeforePoint)};
 395     int digitsAfterPoint{convertedDigits - digitsBeforePoint};
 396     int trailingZeroes{flags & decimal::Minimize
 397             ? 0
 398             : std::max(0,
 399                   significantDigits - (convertedDigits + zeroesBeforePoint))};
 400     int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
 401         1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
 402         expoLength};
 403     int width{editWidth > 0 ? editWidth : totalLength};
 404     if (totalLength > width || !exponent) {
 405       return EmitRepeated(io_, '*', width);
 406     }
 407     if (totalLength < width && digitsBeforePoint == 0 &&
 408         zeroesBeforePoint == 0) {
 409       zeroesBeforePoint = 1;
 410       ++totalLength;
 411     }
 412     if (totalLength < width && editWidth == 0) {
 413       width = totalLength;
 414     }
 415     return EmitPrefix(edit, totalLength, width) &&
 416         EmitAscii(io_, converted.str, signLength + digitsBeforePoint) &&
 417         EmitRepeated(io_, '0', zeroesBeforePoint) &&
 418         EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
 419         EmitRepeated(io_, '0', zeroesAfterPoint) &&
 420         EmitAscii(io_, converted.str + signLength + digitsBeforePoint,
 421             digitsAfterPoint) &&
 422         EmitRepeated(io_, '0', trailingZeroes) &&
 423         EmitAscii(io_, exponent, expoLength) && EmitSuffix(edit);
 424   }
 425 }
 426
 427 // 13.7.2.3.2 in F'2018
 428 template <int KIND>
 429 RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
 430   addSpaceBeforeCharacter(io_);
 431   int fracDigits{edit.digits.value_or(0)}; // 'd' field
 432   const int editWidth{edit.width.value_or(0)}; // 'w' field
 433   enum decimal::FortranRounding rounding{edit.modes.round};
 434   int flags{0};
 435   if (edit.modes.editingFlags & signPlus) {
 436     flags |= decimal::AlwaysSign;
 437   }
 438   if (editWidth == 0) { // "the processor selects the field width"
 439     if (!edit.digits.has_value()) { // F0
 440       flags |= decimal::Minimize;
 441       fracDigits = sizeof buffer_ - 2; // sign & NUL
 442     }
 443   }
 444   bool emitTrailingZeroes{!(flags & decimal::Minimize)};
 445   // Multiple conversions may be needed to get the right number of
 446   // effective rounded fractional digits.
 447   bool canIncrease{true};
 448   for (int extraDigits{fracDigits == 0 ? 1 : 0};;) {
 449     decimal::ConversionToDecimalResult converted{
 450         ConvertToDecimal(extraDigits + fracDigits, rounding, flags)};
 451     const char *convertedStr{converted.str};
 452     if (IsInfOrNaN(convertedStr, static_cast<int>(converted.length))) {
 453       return editWidth > 0 &&
 454               converted.length > static_cast<std::size_t>(editWidth)
 455           ? EmitRepeated(io_, '*', editWidth)
 456           : EmitPrefix(edit, converted.length, editWidth) &&
 457               EmitAscii(io_, convertedStr, converted.length) &&
 458               EmitSuffix(edit);
 459     }
 460     int expo{converted.decimalExponent + edit.modes.scale /*kP*/};
 461     int signLength{*convertedStr == '-' || *convertedStr == '+' ? 1 : 0};
 462     int convertedDigits{static_cast<int>(converted.length) - signLength};
 463     if (IsZero()) { // don't treat converted "0" as significant digit
 464       expo = 0;
 465       convertedDigits = 0;
 466     }
 467     bool isNegative{*convertedStr == '-'};
 468     char one[2];
 469     if (expo > extraDigits && extraDigits >= 0 && canIncrease) {
 470       extraDigits = expo;
 471       if (!edit.digits.has_value()) { // F0
 472         fracDigits = sizeof buffer_ - extraDigits - 2; // sign & NUL
 473       }
 474       canIncrease = false; // only once
 475       continue;
 476     } else if (expo == -fracDigits && convertedDigits > 0) {
 477       // Result will be either a signed zero or power of ten, depending
 478       // on rounding.
 479       char leading{convertedStr[signLength]};
 480       bool roundToPowerOfTen{false};
 481       switch (edit.modes.round) {
 482       case decimal::FortranRounding::RoundUp:
 483         roundToPowerOfTen = !isNegative;
 484         break;
 485       case decimal::FortranRounding::RoundDown:
 486         roundToPowerOfTen = isNegative;
 487         break;
 488       case decimal::FortranRounding::RoundToZero:
 489         break;
 490       case decimal::FortranRounding::RoundNearest:
 491         if (leading == '5' &&
 492             rounding == decimal::FortranRounding::RoundNearest) {
 493           // Try again, rounding away from zero.
 494           rounding = isNegative ? decimal::FortranRounding::RoundDown
 495                                 : decimal::FortranRounding::RoundUp;
 496           extraDigits = 1 - fracDigits; // just one digit needed
 497           continue;
 498         }
 499         roundToPowerOfTen = leading > '5';
 500         break;
 501       case decimal::FortranRounding::RoundCompatible:
 502         roundToPowerOfTen = leading >= '5';
 503         break;
 504       }
 505       if (roundToPowerOfTen) {
 506         ++expo;
 507         convertedDigits = 1;
 508         if (signLength > 0) {
 509           one[0] = *convertedStr;
 510           one[1] = '1';
 511         } else {
 512           one[0] = '1';
 513         }
 514         convertedStr = one;
 515       } else {
 516         expo = 0;
 517         convertedDigits = 0;
 518       }
 519     } else if (expo < extraDigits && extraDigits > -fracDigits) {
 520       extraDigits = std::max(expo, -fracDigits);
 521       continue;
 522     }
 523     int digitsBeforePoint{std::max(0, std::min(expo, convertedDigits))};
 524     int zeroesBeforePoint{std::max(0, expo - digitsBeforePoint)};
 525     if (zeroesBeforePoint > 0 && (flags & decimal::Minimize)) {
 526       // If a minimized result looks like an integer, emit all of
 527       // its digits rather than clipping some to zeroes.
 528       // This can happen with HUGE(0._2) == 65504._2.
 529       flags &= ~decimal::Minimize;
 530       continue;
 531     }
 532     int zeroesAfterPoint{std::min(fracDigits, std::max(0, -expo))};
 533     int digitsAfterPoint{convertedDigits - digitsBeforePoint};
 534     int trailingZeroes{emitTrailingZeroes
 535             ? std::max(0, fracDigits - (zeroesAfterPoint + digitsAfterPoint))
 536             : 0};
 537     if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint +
 538             digitsAfterPoint + trailingZeroes ==
 539         0) {
 540       zeroesBeforePoint = 1; // "." -> "0."
 541     }
 542     int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
 543         1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
 544         trailingBlanks_ /* G editing converted to F */};
 545     int width{editWidth > 0 || trailingBlanks_ ? editWidth : totalLength};
 546     if (totalLength > width) {
 547       return EmitRepeated(io_, '*', width);
 548     }
 549     if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
 550       zeroesBeforePoint = 1;
 551       ++totalLength;
 552     }
 553     return EmitPrefix(edit, totalLength, width) &&
 554         EmitAscii(io_, convertedStr, signLength + digitsBeforePoint) &&
 555         EmitRepeated(io_, '0', zeroesBeforePoint) &&
 556         EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
 557         EmitRepeated(io_, '0', zeroesAfterPoint) &&
 558         EmitAscii(io_, convertedStr + signLength + digitsBeforePoint,
 559             digitsAfterPoint) &&
 560         EmitRepeated(io_, '0', trailingZeroes) &&
 561         EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit);
 562   }
 563 }
 564
 565 // 13.7.5.2.3 in F'2018
 566 template <int KIND>
 567 RT_API_ATTRS DataEdit RealOutputEditing<KIND>::EditForGOutput(DataEdit edit) {
 568   edit.descriptor = 'E';
 569   edit.variation = 'G'; // to suppress error for Ew.0
 570   int editWidth{edit.width.value_or(0)};
 571   int significantDigits{edit.digits.value_or(
 572       static_cast<int>(BinaryFloatingPoint::decimalPrecision))}; // 'd'
 573   if (editWidth > 0 && significantDigits == 0) {
 574     return edit; // Gw.0Ee -> Ew.0Ee for w > 0
 575   }
 576   int flags{0};
 577   if (edit.modes.editingFlags & signPlus) {
 578     flags |= decimal::AlwaysSign;
 579   }
 580   decimal::ConversionToDecimalResult converted{
 581       ConvertToDecimal(significantDigits, edit.modes.round, flags)};
 582   if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
 583     return edit; // Inf/Nan -> Ew.d (same as Fw.d)
 584   }
 585   int expo{IsZero() ? 1 : converted.decimalExponent}; // 's'
 586   if (expo < 0 || expo > significantDigits) {
 587     if (editWidth == 0 && !edit.expoDigits) { // G0.d -> G0.dE0
 588       edit.expoDigits = 0;
 589     }
 590     return edit; // Ew.dEe
 591   }
 592   edit.descriptor = 'F';
 593   edit.modes.scale = 0; // kP is ignored for G when no exponent field
 594   trailingBlanks_ = 0;
 595   if (editWidth > 0) {
 596     int expoDigits{edit.expoDigits.value_or(0)};
 597     // F'2023 13.7.5.2.3 p5: "If 0 <= s <= d, the scale factor has no effect
 598     // and F(w − n).(d − s),n(’b’) editing is used where b is a blank and
 599     // n is 4 for Gw.d editing, e + 2 for Gw.dEe editing if e > 0, and
 600     // 4 for Gw.dE0 editing."
 601     trailingBlanks_ = expoDigits > 0 ? expoDigits + 2 : 4; // 'n'
 602   }
 603   if (edit.digits.has_value()) {
 604     *edit.digits = std::max(0, *edit.digits - expo);
 605   }
 606   return edit;
 607 }
 608
 609 // 13.10.4 in F'2018
 610 template <int KIND>
 611 RT_API_ATTRS bool RealOutputEditing<KIND>::EditListDirectedOutput(
 612     const DataEdit &edit) {
 613   decimal::ConversionToDecimalResult converted{
 614       ConvertToDecimal(1, edit.modes.round)};
 615   if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
 616     DataEdit copy{edit};
 617     copy.variation = DataEdit::ListDirected;
 618     return EditEorDOutput(copy);
 619   }
 620   int expo{converted.decimalExponent};
 621   // The decimal precision of 16-bit floating-point types is very low,
 622   // so use a reasonable cap of 6 to allow more values to be emitted
 623   // with Fw.d editing.
 624   static constexpr int maxExpo{
 625       std::max(6, BinaryFloatingPoint::decimalPrecision)};
 626   if (expo < 0 || expo > maxExpo) {
 627     DataEdit copy{edit};
 628     copy.variation = DataEdit::ListDirected;
 629     copy.modes.scale = 1; // 1P
 630     return EditEorDOutput(copy);
 631   } else {
 632     return EditFOutput(edit);
 633   }
 634 }
 635
 636 // 13.7.2.3.6 in F'2023
 637 // The specification for hexadecimal output, unfortunately for implementors,
 638 // leaves as "implementation dependent" the choice of how to emit values
 639 // with multiple hexadecimal output possibilities that are numerically
 640 // equivalent.  The one working implementation of EX output that I can find
 641 // apparently chooses to frame the nybbles from most to least significant,
 642 // rather than trying to minimize the magnitude of the binary exponent.
 643 // E.g., 2. is edited into 0X8.0P-2 rather than 0X2.0P0.  This implementation
 644 // follows that precedent so as to avoid a gratuitous incompatibility.
 645 template <int KIND>
 646 RT_API_ATTRS auto RealOutputEditing<KIND>::ConvertToHexadecimal(
 647     int significantDigits, enum decimal::FortranRounding rounding,
 648     int flags) -> ConvertToHexadecimalResult {
 649   if (x_.IsNaN() || x_.IsInfinite()) {
 650     auto converted{ConvertToDecimal(significantDigits, rounding, flags)};
 651     return {converted.str, static_cast<int>(converted.length), 0};
 652   }
 653   x_.RoundToBits(4 * significantDigits, rounding);
 654   if (x_.IsInfinite()) { // rounded away to +/-Inf
 655     auto converted{ConvertToDecimal(significantDigits, rounding, flags)};
 656     return {converted.str, static_cast<int>(converted.length), 0};
 657   }
 658   int len{0};
 659   if (x_.IsNegative()) {
 660     buffer_[len++] = '-';
 661   } else if (flags & decimal::AlwaysSign) {
 662     buffer_[len++] = '+';
 663   }
 664   auto fraction{x_.Fraction()};
 665   if (fraction == 0) {
 666     buffer_[len++] = '0';
 667     return {buffer_, len, 0};
 668   } else {
 669     // Ensure that the MSB is set.
 670     int expo{x_.UnbiasedExponent() - 3};
 671     while (!(fraction >> (x_.binaryPrecision - 1))) {
 672       fraction <<= 1;
 673       --expo;
 674     }
 675     // This is initially the right shift count needed to bring the
 676     // most-significant hexadecimal digit's bits into the LSBs.
 677     // x_.binaryPrecision is constant, so / can be used for readability.
 678     int shift{x_.binaryPrecision - 4};
 679     typename BinaryFloatingPoint::RawType one{1};
 680     auto remaining{(one << x_.binaryPrecision) - one};
 681     for (int digits{0}; digits < significantDigits; ++digits) {
 682       if ((flags & decimal::Minimize) && !(fraction & remaining)) {
 683         break;
 684       }
 685       int hexDigit{0};
 686       if (shift >= 0) {
 687         hexDigit = int(fraction >> shift) & 0xf;
 688       } else if (shift >= -3) {
 689         hexDigit = int(fraction << -shift) & 0xf;
 690       }
 691       if (hexDigit >= 10) {
 692         buffer_[len++] = 'A' + hexDigit - 10;
 693       } else {
 694         buffer_[len++] = '0' + hexDigit;
 695       }
 696       shift -= 4;
 697       remaining >>= 4;
 698     }
 699     return {buffer_, len, expo};
 700   }
 701 }
 702
 703 template <int KIND>
 704 RT_API_ATTRS bool RealOutputEditing<KIND>::EditEXOutput(const DataEdit &edit) {
 705   addSpaceBeforeCharacter(io_);
 706   int editDigits{edit.digits.value_or(0)}; // 'd' field
 707   int significantDigits{editDigits + 1};
 708   int flags{0};
 709   if (edit.modes.editingFlags & signPlus) {
 710     flags |= decimal::AlwaysSign;
 711   }
 712   int editWidth{edit.width.value_or(0)}; // 'w' field
 713   if ((editWidth == 0 && !edit.digits) || editDigits == 0) {
 714     // EX0 or EXw.0
 715     flags |= decimal::Minimize;
 716     static constexpr int maxSigHexDigits{
 717         (common::PrecisionOfRealKind(16) + 3) / 4};
 718     significantDigits = maxSigHexDigits;
 719   }
 720   auto converted{
 721       ConvertToHexadecimal(significantDigits, edit.modes.round, flags)};
 722   if (IsInfOrNaN(converted.str, converted.length)) {
 723     return editWidth > 0 && converted.length > editWidth
 724         ? EmitRepeated(io_, '*', editWidth)
 725         : (editWidth <= converted.length ||
 726               EmitRepeated(io_, ' ', editWidth - converted.length)) &&
 727             EmitAscii(io_, converted.str, converted.length);
 728   }
 729   int signLength{converted.length > 0 &&
 730               (converted.str[0] == '-' || converted.str[0] == '+')
 731           ? 1
 732           : 0};
 733   int convertedDigits{converted.length - signLength};
 734   int expoLength{0};
 735   const char *exponent{FormatExponent(converted.exponent, edit, expoLength)};
 736   int trailingZeroes{flags & decimal::Minimize
 737           ? 0
 738           : std::max(0, significantDigits - convertedDigits)};
 739   int totalLength{converted.length + trailingZeroes + expoLength + 3 /*0X.*/};
 740   int width{editWidth > 0 ? editWidth : totalLength};
 741   return totalLength > width || !exponent
 742       ? EmitRepeated(io_, '*', width)
 743       : EmitRepeated(io_, ' ', width - totalLength) &&
 744           EmitAscii(io_, converted.str, signLength) &&
 745           EmitAscii(io_, "0X", 2) &&
 746           EmitAscii(io_, converted.str + signLength, 1) &&
 747           EmitAscii(
 748               io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
 749           EmitAscii(io_, converted.str + signLength + 1,
 750               converted.length - (signLength + 1)) &&
 751           EmitRepeated(io_, '0', trailingZeroes) &&
 752           EmitAscii(io_, exponent, expoLength);
 753 }
 754
 755 template <int KIND>
 756 RT_API_ATTRS bool RealOutputEditing<KIND>::Edit(const DataEdit &edit) {
 757   const DataEdit *editPtr{&edit};
 758   DataEdit newEdit;
 759   if (editPtr->descriptor == 'G') {
 760     // Avoid recursive call as in Edit(EditForGOutput(edit)).
 761     newEdit = EditForGOutput(*editPtr);
 762     editPtr = &newEdit;
 763     RUNTIME_CHECK(io_.GetIoErrorHandler(), editPtr->descriptor != 'G');
 764   }
 765   switch (editPtr->descriptor) {
 766   case 'D':
 767     return EditEorDOutput(*editPtr);
 768   case 'E':
 769     if (editPtr->variation == 'X') {
 770       return EditEXOutput(*editPtr);
 771     } else {
 772       return EditEorDOutput(*editPtr);
 773     }
 774   case 'F':
 775     return EditFOutput(*editPtr);
 776   case 'B':
 777     return EditBOZOutput<1>(io_, *editPtr,
 778         reinterpret_cast<const unsigned char *>(&x_),
 779         common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
 780   case 'O':
 781     return EditBOZOutput<3>(io_, *editPtr,
 782         reinterpret_cast<const unsigned char *>(&x_),
 783         common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
 784   case 'Z':
 785     return EditBOZOutput<4>(io_, *editPtr,
 786         reinterpret_cast<const unsigned char *>(&x_),
 787         common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
 788   case 'L':
 789     return EditLogicalOutput(
 790         io_, *editPtr, *reinterpret_cast<const char *>(&x_));
 791   case 'A': // legacy extension
 792     return EditCharacterOutput(
 793         io_, *editPtr, reinterpret_cast<char *>(&x_), sizeof x_);
 794   default:
 795     if (editPtr->IsListDirected()) {
 796       return EditListDirectedOutput(*editPtr);
 797     }
 798     io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
 799         "Data edit descriptor '%c' may not be used with a REAL data item",
 800         editPtr->descriptor);
 801     return false;
 802   }
 803   return false;
 804 }
 805
 806 RT_API_ATTRS bool ListDirectedLogicalOutput(IoStatementState &io,
 807     ListDirectedStatementState<Direction::Output> &list, bool truth) {
 808   return list.EmitLeadingSpaceOrAdvance(io) &&
 809       EmitAscii(io, truth ? "T" : "F", 1);
 810 }
 811
 812 RT_API_ATTRS bool EditLogicalOutput(
 813     IoStatementState &io, const DataEdit &edit, bool truth) {
 814   switch (edit.descriptor) {
 815   case 'L':
 816   case 'G':
 817     return EmitRepeated(io, ' ', std::max(0, edit.width.value_or(1) - 1)) &&
 818         EmitAscii(io, truth ? "T" : "F", 1);
 819   case 'B':
 820     return EditBOZOutput<1>(io, edit,
 821         reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
 822   case 'O':
 823     return EditBOZOutput<3>(io, edit,
 824         reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
 825   case 'Z':
 826     return EditBOZOutput<4>(io, edit,
 827         reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
 828   case 'A': { // legacy extension
 829     int truthBits{truth};
 830     int len{sizeof truthBits};
 831     int width{edit.width.value_or(len)};
 832     return EmitRepeated(io, ' ', std::max(0, width - len)) &&
 833         EmitEncoded(
 834             io, reinterpret_cast<char *>(&truthBits), std::min(width, len));
 835   }
 836   default:
 837     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
 838         "Data edit descriptor '%c' may not be used with a LOGICAL data item",
 839         edit.descriptor);
 840     return false;
 841   }
 842 }
 843
 844 template <typename CHAR>
 845 RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &io,
 846     ListDirectedStatementState<Direction::Output> &list, const CHAR *x,
 847     std::size_t length) {
 848   bool ok{true};
 849   MutableModes &modes{io.mutableModes()};
 850   ConnectionState &connection{io.GetConnectionState()};
 851   if (modes.delim) {
 852     ok = ok && list.EmitLeadingSpaceOrAdvance(io);
 853     // Value is delimited with ' or " marks, and interior
 854     // instances of that character are doubled.
 855     auto EmitOne{[&](CHAR ch) {
 856       if (connection.NeedAdvance(1)) {
 857         ok = ok && io.AdvanceRecord();
 858       }
 859       ok = ok && EmitEncoded(io, &ch, 1);
 860     }};
 861     EmitOne(modes.delim);
 862     for (std::size_t j{0}; j < length; ++j) {
 863       // Doubled delimiters must be put on the same record
 864       // in order to be acceptable as list-directed or NAMELIST
 865       // input; however, this requirement is not always possible
 866       // when the records have a fixed length, as is the case with
 867       // internal output.  The standard is silent on what should
 868       // happen, and no two extant Fortran implementations do
 869       // the same thing when tested with this case.
 870       // This runtime splits the doubled delimiters across
 871       // two records for lack of a better alternative.
 872       if (x[j] == static_cast<CHAR>(modes.delim)) {
 873         EmitOne(x[j]);
 874       }
 875       EmitOne(x[j]);
 876     }
 877     EmitOne(modes.delim);
 878   } else {
 879     // Undelimited list-directed output
 880     ok = ok && list.EmitLeadingSpaceOrAdvance(io, length > 0 ? 1 : 0, true);
 881     std::size_t put{0};
 882     std::size_t oneAtATime{
 883         connection.useUTF8<CHAR>() || connection.internalIoCharKind > 1
 884             ? 1
 885             : length};
 886     while (ok && put < length) {
 887       if (std::size_t chunk{std::min<std::size_t>(
 888               std::min<std::size_t>(length - put, oneAtATime),
 889               connection.RemainingSpaceInRecord())}) {
 890         ok = EmitEncoded(io, x + put, chunk);
 891         put += chunk;
 892       } else {
 893         ok = io.AdvanceRecord() && EmitAscii(io, " ", 1);
 894       }
 895     }
 896     list.set_lastWasUndelimitedCharacter(true);
 897   }
 898   return ok;
 899 }
 900
 901 template <typename CHAR>
 902 RT_API_ATTRS bool EditCharacterOutput(IoStatementState &io,
 903     const DataEdit &edit, const CHAR *x, std::size_t length) {
 904   int len{static_cast<int>(length)};
 905   int width{edit.width.value_or(len)};
 906   switch (edit.descriptor) {
 907   case 'A':
 908     break;
 909   case 'G':
 910     if (width == 0) {
 911       width = len;
 912     }
 913     break;
 914   case 'B':
 915     return EditBOZOutput<1>(io, edit,
 916         reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
 917   case 'O':
 918     return EditBOZOutput<3>(io, edit,
 919         reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
 920   case 'Z':
 921     return EditBOZOutput<4>(io, edit,
 922         reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
 923   case 'L':
 924     return EditLogicalOutput(io, edit, *reinterpret_cast<const char *>(x));
 925   default:
 926     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
 927         "Data edit descriptor '%c' may not be used with a CHARACTER data item",
 928         edit.descriptor);
 929     return false;
 930   }
 931   return EmitRepeated(io, ' ', std::max(0, width - len)) &&
 932       EmitEncoded(io, x, std::min(width, len));
 933 }
 934
 935 template RT_API_ATTRS bool EditIntegerOutput<1>(
 936     IoStatementState &, const DataEdit &, std::int8_t);
 937 template RT_API_ATTRS bool EditIntegerOutput<2>(
 938     IoStatementState &, const DataEdit &, std::int16_t);
 939 template RT_API_ATTRS bool EditIntegerOutput<4>(
 940     IoStatementState &, const DataEdit &, std::int32_t);
 941 template RT_API_ATTRS bool EditIntegerOutput<8>(
 942     IoStatementState &, const DataEdit &, std::int64_t);
 943 template RT_API_ATTRS bool EditIntegerOutput<16>(
 944     IoStatementState &, const DataEdit &, common::int128_t);
 945
 946 template class RealOutputEditing<2>;
 947 template class RealOutputEditing<3>;
 948 template class RealOutputEditing<4>;
 949 template class RealOutputEditing<8>;
 950 template class RealOutputEditing<10>;
 951 // TODO: double/double
 952 template class RealOutputEditing<16>;
 953
 954 template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
 955     ListDirectedStatementState<Direction::Output> &, const char *,
 956     std::size_t chars);
 957 template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
 958     ListDirectedStatementState<Direction::Output> &, const char16_t *,
 959     std::size_t chars);
 960 template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
 961     ListDirectedStatementState<Direction::Output> &, const char32_t *,
 962     std::size_t chars);
 963
 964 template RT_API_ATTRS bool EditCharacterOutput(
 965     IoStatementState &, const DataEdit &, const char *, std::size_t chars);
 966 template RT_API_ATTRS bool EditCharacterOutput(
 967     IoStatementState &, const DataEdit &, const char16_t *, std::size_t chars);
 968 template RT_API_ATTRS bool EditCharacterOutput(
 969     IoStatementState &, const DataEdit &, const char32_t *, std::size_t chars);
 970
 971 RT_OFFLOAD_API_GROUP_END
 972 } // namespace Fortran::runtime::io