xref: /llvm-project/flang/runtime/edit-output.cpp (revision fc97d2e68b03bc2979395e84b645e5b3ba35aecd)
1651f58bfSDiana Picus //===-- runtime/edit-output.cpp -------------------------------------------===//
23b635714Speter klausler //
33b635714Speter klausler // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
43b635714Speter klausler // See https://llvm.org/LICENSE.txt for license information.
53b635714Speter klausler // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
63b635714Speter klausler //
73b635714Speter klausler //===----------------------------------------------------------------------===//
83b635714Speter klausler 
93b635714Speter klausler #include "edit-output.h"
10bad52055SPeter Klausler #include "emit-encoded.h"
11bafbae23SPeter Klausler #include "utf.h"
125e21fa23SPeter Klausler #include "flang/Common/real.h"
133b635714Speter klausler #include "flang/Common/uint128.h"
14231fae90SIsuru Fernando #include <algorithm>
153b635714Speter klausler 
163b635714Speter klausler namespace Fortran::runtime::io {
178ebf7411SSlava Zakharin RT_OFFLOAD_API_GROUP_BEGIN
183b635714Speter klausler 
198cfdc32bSShao-Ce SUN // In output statement, add a space between numbers and characters.
208ebf7411SSlava Zakharin static RT_API_ATTRS void addSpaceBeforeCharacter(IoStatementState &io) {
218cfdc32bSShao-Ce SUN   if (auto *list{io.get_if<ListDirectedStatementState<Direction::Output>>()}) {
228cfdc32bSShao-Ce SUN     list->set_lastWasUndelimitedCharacter(false);
238cfdc32bSShao-Ce SUN   }
248cfdc32bSShao-Ce SUN }
258cfdc32bSShao-Ce SUN 
2653f775bbSPeter Klausler // B/O/Z output of arbitrarily sized data emits a binary/octal/hexadecimal
2753f775bbSPeter Klausler // representation of what is interpreted to be a single unsigned integer value.
2853f775bbSPeter Klausler // When used with character data, endianness is exposed.
2953f775bbSPeter Klausler template <int LOG2_BASE>
308ebf7411SSlava Zakharin static RT_API_ATTRS bool EditBOZOutput(IoStatementState &io,
318ebf7411SSlava Zakharin     const DataEdit &edit, const unsigned char *data0, std::size_t bytes) {
328cfdc32bSShao-Ce SUN   addSpaceBeforeCharacter(io);
3353f775bbSPeter Klausler   int digits{static_cast<int>((bytes * 8) / LOG2_BASE)};
3453f775bbSPeter Klausler   int get{static_cast<int>(bytes * 8) - digits * LOG2_BASE};
35604016dbSPeter Klausler   if (get > 0) {
36604016dbSPeter Klausler     ++digits;
37604016dbSPeter Klausler   } else {
38604016dbSPeter Klausler     get = LOG2_BASE;
39604016dbSPeter Klausler   }
4053f775bbSPeter Klausler   int shift{7};
4153f775bbSPeter Klausler   int increment{isHostLittleEndian ? -1 : 1};
4253f775bbSPeter Klausler   const unsigned char *data{data0 + (isHostLittleEndian ? bytes - 1 : 0)};
4353f775bbSPeter Klausler   int skippedZeroes{0};
4453f775bbSPeter Klausler   int digit{0};
4553f775bbSPeter Klausler   // The same algorithm is used to generate digits for real (below)
4653f775bbSPeter Klausler   // as well as for generating them only to skip leading zeroes (here).
4753f775bbSPeter Klausler   // Bits are copied one at a time from the source data.
4853f775bbSPeter Klausler   // TODO: Multiple bit copies for hexadecimal, where misalignment
4953f775bbSPeter Klausler   // is not possible; or for octal when all 3 bits come from the
5053f775bbSPeter Klausler   // same byte.
5153f775bbSPeter Klausler   while (bytes > 0) {
5253f775bbSPeter Klausler     if (get == 0) {
5353f775bbSPeter Klausler       if (digit != 0) {
5453f775bbSPeter Klausler         break; // first nonzero leading digit
5553f775bbSPeter Klausler       }
5653f775bbSPeter Klausler       ++skippedZeroes;
5753f775bbSPeter Klausler       get = LOG2_BASE;
5853f775bbSPeter Klausler     } else if (shift < 0) {
5953f775bbSPeter Klausler       data += increment;
6053f775bbSPeter Klausler       --bytes;
6153f775bbSPeter Klausler       shift = 7;
6253f775bbSPeter Klausler     } else {
6353f775bbSPeter Klausler       digit = 2 * digit + ((*data >> shift--) & 1);
6453f775bbSPeter Klausler       --get;
6553f775bbSPeter Klausler     }
6653f775bbSPeter Klausler   }
6753f775bbSPeter Klausler   // Emit leading spaces and zeroes; detect field overflow
6853f775bbSPeter Klausler   int leadingZeroes{0};
6953f775bbSPeter Klausler   int editWidth{edit.width.value_or(0)};
7053f775bbSPeter Klausler   int significant{digits - skippedZeroes};
7153f775bbSPeter Klausler   if (edit.digits && significant <= *edit.digits) { // Bw.m, Ow.m, Zw.m
7253f775bbSPeter Klausler     if (*edit.digits == 0 && bytes == 0) {
7353f775bbSPeter Klausler       editWidth = std::max(1, editWidth);
7453f775bbSPeter Klausler     } else {
7553f775bbSPeter Klausler       leadingZeroes = *edit.digits - significant;
7653f775bbSPeter Klausler     }
7753f775bbSPeter Klausler   } else if (bytes == 0) {
7853f775bbSPeter Klausler     leadingZeroes = 1;
7953f775bbSPeter Klausler   }
8053f775bbSPeter Klausler   int subTotal{leadingZeroes + significant};
8153f775bbSPeter Klausler   int leadingSpaces{std::max(0, editWidth - subTotal)};
8253f775bbSPeter Klausler   if (editWidth > 0 && leadingSpaces + subTotal > editWidth) {
83bad52055SPeter Klausler     return EmitRepeated(io, '*', editWidth);
8453f775bbSPeter Klausler   }
85bad52055SPeter Klausler   if (!(EmitRepeated(io, ' ', leadingSpaces) &&
86bad52055SPeter Klausler           EmitRepeated(io, '0', leadingZeroes))) {
8753f775bbSPeter Klausler     return false;
8853f775bbSPeter Klausler   }
8953f775bbSPeter Klausler   // Emit remaining digits
9053f775bbSPeter Klausler   while (bytes > 0) {
9153f775bbSPeter Klausler     if (get == 0) {
9253f775bbSPeter Klausler       char ch{static_cast<char>(digit >= 10 ? 'A' + digit - 10 : '0' + digit)};
93bad52055SPeter Klausler       if (!EmitAscii(io, &ch, 1)) {
9453f775bbSPeter Klausler         return false;
9553f775bbSPeter Klausler       }
9653f775bbSPeter Klausler       get = LOG2_BASE;
9753f775bbSPeter Klausler       digit = 0;
9853f775bbSPeter Klausler     } else if (shift < 0) {
9953f775bbSPeter Klausler       data += increment;
10053f775bbSPeter Klausler       --bytes;
10153f775bbSPeter Klausler       shift = 7;
10253f775bbSPeter Klausler     } else {
10353f775bbSPeter Klausler       digit = 2 * digit + ((*data >> shift--) & 1);
10453f775bbSPeter Klausler       --get;
10553f775bbSPeter Klausler     }
10653f775bbSPeter Klausler   }
10753f775bbSPeter Klausler   return true;
10853f775bbSPeter Klausler }
10953f775bbSPeter Klausler 
110f65f830eSpeter klausler template <int KIND>
1118ebf7411SSlava Zakharin bool RT_API_ATTRS EditIntegerOutput(IoStatementState &io, const DataEdit &edit,
112*fc97d2e6SPeter Klausler     common::HostSignedIntType<8 * KIND> n, bool isSigned) {
1138cfdc32bSShao-Ce SUN   addSpaceBeforeCharacter(io);
114f65f830eSpeter klausler   char buffer[130], *end{&buffer[sizeof buffer]}, *p{end};
115*fc97d2e6SPeter Klausler   bool isNegative{isSigned && n < 0};
116f65f830eSpeter klausler   using Unsigned = common::HostUnsignedIntType<8 * KIND>;
117f65f830eSpeter klausler   Unsigned un{static_cast<Unsigned>(n)};
1183b635714Speter klausler   int signChars{0};
1193b635714Speter klausler   switch (edit.descriptor) {
1203b635714Speter klausler   case DataEdit::ListDirected:
1213b635714Speter klausler   case 'G':
1223b635714Speter klausler   case 'I':
123f65f830eSpeter klausler     if (isNegative) {
124c5a5517bSpeter klausler       un = -un;
125f65f830eSpeter klausler     }
1263b635714Speter klausler     if (isNegative || (edit.modes.editingFlags & signPlus)) {
1273b635714Speter klausler       signChars = 1; // '-' or '+'
1283b635714Speter klausler     }
1293b635714Speter klausler     while (un > 0) {
130e99d184dSpeter klausler       auto quotient{un / 10u};
131c5a5517bSpeter klausler       *--p = '0' + static_cast<int>(un - Unsigned{10} * quotient);
1323b635714Speter klausler       un = quotient;
1333b635714Speter klausler     }
1343b635714Speter klausler     break;
1353b635714Speter klausler   case 'B':
13653f775bbSPeter Klausler     return EditBOZOutput<1>(
13753f775bbSPeter Klausler         io, edit, reinterpret_cast<const unsigned char *>(&n), KIND);
1383b635714Speter klausler   case 'O':
13953f775bbSPeter Klausler     return EditBOZOutput<3>(
14053f775bbSPeter Klausler         io, edit, reinterpret_cast<const unsigned char *>(&n), KIND);
1413b635714Speter klausler   case 'Z':
14253f775bbSPeter Klausler     return EditBOZOutput<4>(
14353f775bbSPeter Klausler         io, edit, reinterpret_cast<const unsigned char *>(&n), KIND);
14477d667b1SShao-Ce SUN   case 'L':
1453bc7e552Skkwli     return EditLogicalOutput(io, edit, n != 0 ? true : false);
146b83242e2Speter klausler   case 'A': // legacy extension
147bafbae23SPeter Klausler     return EditCharacterOutput(
148b83242e2Speter klausler         io, edit, reinterpret_cast<char *>(&n), sizeof n);
1493b635714Speter klausler   default:
15088d4b85fSJean Perier     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
1513b635714Speter klausler         "Data edit descriptor '%c' may not be used with an INTEGER data item",
1523b635714Speter klausler         edit.descriptor);
1533b635714Speter klausler     return false;
1543b635714Speter klausler   }
1553b635714Speter klausler 
1563b635714Speter klausler   int digits = end - p;
1573b635714Speter klausler   int leadingZeroes{0};
1583b635714Speter klausler   int editWidth{edit.width.value_or(0)};
159212beb66SPeter Klausler   if (edit.descriptor == 'I' && edit.digits && digits <= *edit.digits) {
160212beb66SPeter Klausler     // Only Iw.m can produce leading zeroes, not Gw.d (F'202X 13.7.5.2.2)
1613b635714Speter klausler     if (*edit.digits == 0 && n == 0) {
1623b635714Speter klausler       // Iw.0 with zero value: output field must be blank.  For I0.0
1633b635714Speter klausler       // and a zero value, emit one blank character.
1643b635714Speter klausler       signChars = 0; // in case of SP
1653b635714Speter klausler       editWidth = std::max(1, editWidth);
1663b635714Speter klausler     } else {
1673b635714Speter klausler       leadingZeroes = *edit.digits - digits;
1683b635714Speter klausler     }
1693b635714Speter klausler   } else if (n == 0) {
1703b635714Speter klausler     leadingZeroes = 1;
1713b635714Speter klausler   }
1726a1c3efaSpeter klausler   int subTotal{signChars + leadingZeroes + digits};
1736a1c3efaSpeter klausler   int leadingSpaces{std::max(0, editWidth - subTotal)};
1746a1c3efaSpeter klausler   if (editWidth > 0 && leadingSpaces + subTotal > editWidth) {
175bad52055SPeter Klausler     return EmitRepeated(io, '*', editWidth);
1763b635714Speter klausler   }
1773b635714Speter klausler   if (edit.IsListDirected()) {
1786a1c3efaSpeter klausler     int total{std::max(leadingSpaces, 1) + subTotal};
1796a1c3efaSpeter klausler     if (io.GetConnectionState().NeedAdvance(static_cast<std::size_t>(total)) &&
1803b635714Speter klausler         !io.AdvanceRecord()) {
1813b635714Speter klausler       return false;
1823b635714Speter klausler     }
1833b635714Speter klausler     leadingSpaces = 1;
1843b635714Speter klausler   }
185bad52055SPeter Klausler   return EmitRepeated(io, ' ', leadingSpaces) &&
186bad52055SPeter Klausler       EmitAscii(io, n < 0 ? "-" : "+", signChars) &&
187bad52055SPeter Klausler       EmitRepeated(io, '0', leadingZeroes) && EmitAscii(io, p, digits);
1883b635714Speter klausler }
1893b635714Speter klausler 
1903b635714Speter klausler // Formats the exponent (see table 13.1 for all the cases)
1918ebf7411SSlava Zakharin RT_API_ATTRS const char *RealOutputEditingBase::FormatExponent(
1923b635714Speter klausler     int expo, const DataEdit &edit, int &length) {
1933b635714Speter klausler   char *eEnd{&exponent_[sizeof exponent_]};
1943b635714Speter klausler   char *exponent{eEnd};
1953b635714Speter klausler   for (unsigned e{static_cast<unsigned>(std::abs(expo))}; e > 0;) {
196e99d184dSpeter klausler     unsigned quotient{e / 10u};
1973b635714Speter klausler     *--exponent = '0' + e - 10 * quotient;
1983b635714Speter klausler     e = quotient;
1993b635714Speter klausler   }
200db52dda8SPeter Klausler   bool overflow{false};
2013b635714Speter klausler   if (edit.expoDigits) {
2023b635714Speter klausler     if (int ed{*edit.expoDigits}) { // Ew.dEe with e > 0
203db52dda8SPeter Klausler       overflow = exponent + ed < eEnd;
2043b635714Speter klausler       while (exponent > exponent_ + 2 /*E+*/ && exponent + ed > eEnd) {
2053b635714Speter klausler         *--exponent = '0';
2063b635714Speter klausler       }
2073b635714Speter klausler     } else if (exponent == eEnd) {
2083b635714Speter klausler       *--exponent = '0'; // Ew.dE0 with zero-valued exponent
2093b635714Speter klausler     }
210ea7e50cdSPeter Klausler   } else if (edit.variation == 'X') {
211ea7e50cdSPeter Klausler     if (expo == 0) {
212ea7e50cdSPeter Klausler       *--exponent = '0'; // EX without Ee and zero-valued exponent
213ea7e50cdSPeter Klausler     }
214ea7e50cdSPeter Klausler   } else {
215ea7e50cdSPeter Klausler     // Ensure at least two exponent digits unless EX
2163b635714Speter klausler     while (exponent + 2 > eEnd) {
2173b635714Speter klausler       *--exponent = '0';
2183b635714Speter klausler     }
2193b635714Speter klausler   }
2203b635714Speter klausler   *--exponent = expo < 0 ? '-' : '+';
221ea7e50cdSPeter Klausler   if (edit.variation == 'X') {
222ea7e50cdSPeter Klausler     *--exponent = 'P';
223ea7e50cdSPeter Klausler   } else if (edit.expoDigits || edit.IsListDirected() || exponent + 3 == eEnd) {
224df6afee9SPeter Klausler     *--exponent = edit.descriptor == 'D' ? 'D' : 'E'; // not 'G' or 'Q'
2253b635714Speter klausler   }
2263b635714Speter klausler   length = eEnd - exponent;
227db52dda8SPeter Klausler   return overflow ? nullptr : exponent;
2283b635714Speter klausler }
2293b635714Speter klausler 
2308ebf7411SSlava Zakharin RT_API_ATTRS bool RealOutputEditingBase::EmitPrefix(
2313b635714Speter klausler     const DataEdit &edit, std::size_t length, std::size_t width) {
2323b635714Speter klausler   if (edit.IsListDirected()) {
233dd904082STim Keith     int prefixLength{edit.descriptor == DataEdit::ListDirectedRealPart ? 2
234dd904082STim Keith             : edit.descriptor == DataEdit::ListDirectedImaginaryPart   ? 0
235dd904082STim Keith                                                                        : 1};
2363b635714Speter klausler     int suffixLength{edit.descriptor == DataEdit::ListDirectedRealPart ||
2373b635714Speter klausler                 edit.descriptor == DataEdit::ListDirectedImaginaryPart
2383b635714Speter klausler             ? 1
2393b635714Speter klausler             : 0};
2403b635714Speter klausler     length += prefixLength + suffixLength;
2413b635714Speter klausler     ConnectionState &connection{io_.GetConnectionState()};
2426a1c3efaSpeter klausler     return (!connection.NeedAdvance(length) || io_.AdvanceRecord()) &&
243bad52055SPeter Klausler         EmitAscii(io_, " (", prefixLength);
2443b635714Speter klausler   } else if (width > length) {
245bad52055SPeter Klausler     return EmitRepeated(io_, ' ', width - length);
2463b635714Speter klausler   } else {
2473b635714Speter klausler     return true;
2483b635714Speter klausler   }
2493b635714Speter klausler }
2503b635714Speter klausler 
2518ebf7411SSlava Zakharin RT_API_ATTRS bool RealOutputEditingBase::EmitSuffix(const DataEdit &edit) {
2523b635714Speter klausler   if (edit.descriptor == DataEdit::ListDirectedRealPart) {
253bad52055SPeter Klausler     return EmitAscii(
254bad52055SPeter Klausler         io_, edit.modes.editingFlags & decimalComma ? ";" : ",", 1);
2553b635714Speter klausler   } else if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
256bad52055SPeter Klausler     return EmitAscii(io_, ")", 1);
2573b635714Speter klausler   } else {
2583b635714Speter klausler     return true;
2593b635714Speter klausler   }
2603b635714Speter klausler }
2613b635714Speter klausler 
262e593940bSPeter Klausler template <int KIND>
2638ebf7411SSlava Zakharin RT_API_ATTRS decimal::ConversionToDecimalResult
2648ebf7411SSlava Zakharin RealOutputEditing<KIND>::ConvertToDecimal(
265d1b09adeSPeter Klausler     int significantDigits, enum decimal::FortranRounding rounding, int flags) {
2663b635714Speter klausler   auto converted{decimal::ConvertToDecimal<binaryPrecision>(buffer_,
2673b635714Speter klausler       sizeof buffer_, static_cast<enum decimal::DecimalConversionFlags>(flags),
268d1b09adeSPeter Klausler       significantDigits, rounding, x_)};
2693b635714Speter klausler   if (!converted.str) { // overflow
2703b635714Speter klausler     io_.GetIoErrorHandler().Crash(
271ea7e50cdSPeter Klausler         "RealOutputEditing::ConvertToDecimal: buffer size %zd was insufficient",
2723b635714Speter klausler         sizeof buffer_);
2733b635714Speter klausler   }
2743b635714Speter klausler   return converted;
2753b635714Speter klausler }
2763b635714Speter klausler 
2778ebf7411SSlava Zakharin static RT_API_ATTRS bool IsInfOrNaN(const char *p, int length) {
278ea7e50cdSPeter Klausler   if (!p || length < 1) {
279ea7e50cdSPeter Klausler     return false;
280ea7e50cdSPeter Klausler   }
281ea7e50cdSPeter Klausler   if (*p == '-' || *p == '+') {
282ea7e50cdSPeter Klausler     if (length == 1) {
283ea7e50cdSPeter Klausler       return false;
284ea7e50cdSPeter Klausler     }
285ea7e50cdSPeter Klausler     ++p;
286ea7e50cdSPeter Klausler   }
287ea7e50cdSPeter Klausler   return *p == 'I' || *p == 'N';
288ea7e50cdSPeter Klausler }
289ea7e50cdSPeter Klausler 
2903b635714Speter klausler // 13.7.2.3.3 in F'2018
291e593940bSPeter Klausler template <int KIND>
2928ebf7411SSlava Zakharin RT_API_ATTRS bool RealOutputEditing<KIND>::EditEorDOutput(
2938ebf7411SSlava Zakharin     const DataEdit &edit) {
2948cfdc32bSShao-Ce SUN   addSpaceBeforeCharacter(io_);
2953b635714Speter klausler   int editDigits{edit.digits.value_or(0)}; // 'd' field
2963b635714Speter klausler   int editWidth{edit.width.value_or(0)}; // 'w' field
2973b635714Speter klausler   int significantDigits{editDigits};
2983b635714Speter klausler   int flags{0};
299d1b09adeSPeter Klausler   if (edit.modes.editingFlags & signPlus) {
300d1b09adeSPeter Klausler     flags |= decimal::AlwaysSign;
301d1b09adeSPeter Klausler   }
30253dca2e6SPeter Klausler   int scale{edit.modes.scale}; // 'kP' value
303b1a1d4e0SPeter Klausler   bool isEN{edit.variation == 'N'};
304b1a1d4e0SPeter Klausler   bool isES{edit.variation == 'S'};
3053b635714Speter klausler   if (editWidth == 0) { // "the processor selects the field width"
3063b635714Speter klausler     if (edit.digits.has_value()) { // E0.d
30753dca2e6SPeter Klausler       if (editDigits == 0 && scale <= 0) { // E0.0
308b1a1d4e0SPeter Klausler         significantDigits = isEN || isES ? 0 : 1;
309da63fee0SPeter Klausler       }
3103b635714Speter klausler     } else { // E0
3113b635714Speter klausler       flags |= decimal::Minimize;
3123b635714Speter klausler       significantDigits =
3133b635714Speter klausler           sizeof buffer_ - 5; // sign, NUL, + 3 extra for EN scaling
3143b635714Speter klausler     }
3153b635714Speter klausler   }
3163b635714Speter klausler   int zeroesAfterPoint{0};
317dfcccc6dSPeter Klausler   if (isEN) {
318dfcccc6dSPeter Klausler     scale = IsZero() ? 1 : 3;
319dfcccc6dSPeter Klausler     significantDigits += scale;
320dfcccc6dSPeter Klausler   } else if (isES) {
321dfcccc6dSPeter Klausler     scale = 1;
322dfcccc6dSPeter Klausler     ++significantDigits;
323dfcccc6dSPeter Klausler   } else if (scale < 0) {
324c02abb68SPeter Klausler     if (scale <= -editDigits) {
325c02abb68SPeter Klausler       io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor,
326c02abb68SPeter Klausler           "Scale factor (kP) %d cannot be less than -d (%d)", scale,
327c02abb68SPeter Klausler           -editDigits);
328c02abb68SPeter Klausler       return false;
329c02abb68SPeter Klausler     }
3303b635714Speter klausler     zeroesAfterPoint = -scale;
3313b635714Speter klausler     significantDigits = std::max(0, significantDigits - zeroesAfterPoint);
3323b635714Speter klausler   } else if (scale > 0) {
333c02abb68SPeter Klausler     if (scale >= editDigits + 2) {
334c02abb68SPeter Klausler       io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor,
335c02abb68SPeter Klausler           "Scale factor (kP) %d cannot be greater than d+2 (%d)", scale,
336c02abb68SPeter Klausler           editDigits + 2);
337c02abb68SPeter Klausler       return false;
338c02abb68SPeter Klausler     }
3393b635714Speter klausler     ++significantDigits;
3403b635714Speter klausler     scale = std::min(scale, significantDigits + 1);
341033b491cSPeter Klausler   } else if (edit.digits.value_or(1) == 0 && !edit.variation) {
342033b491cSPeter Klausler     // F'2023 13.7.2.3.3 p5; does not apply to Gw.0(Ee) or E0(no d)
343033b491cSPeter Klausler     io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
344033b491cSPeter Klausler         "Output edit descriptor %cw.d must have d>0", edit.descriptor);
345033b491cSPeter Klausler     return false;
3463b635714Speter klausler   }
347dfcccc6dSPeter Klausler   // In EN editing, multiple attempts may be necessary, so this is a loop.
3483b635714Speter klausler   while (true) {
3493b635714Speter klausler     decimal::ConversionToDecimalResult converted{
350ea7e50cdSPeter Klausler         ConvertToDecimal(significantDigits, edit.modes.round, flags)};
351ea7e50cdSPeter Klausler     if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
352763e036cSPeter Klausler       return editWidth > 0 &&
353933882f7SPeter Klausler               converted.length + trailingBlanks_ >
354933882f7SPeter Klausler                   static_cast<std::size_t>(editWidth)
355763e036cSPeter Klausler           ? EmitRepeated(io_, '*', editWidth)
356763e036cSPeter Klausler           : EmitPrefix(edit, converted.length, editWidth) &&
357763e036cSPeter Klausler               EmitAscii(io_, converted.str, converted.length) &&
358933882f7SPeter Klausler               EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit);
3593b635714Speter klausler     }
3603b635714Speter klausler     if (!IsZero()) {
3613b635714Speter klausler       converted.decimalExponent -= scale;
3623b635714Speter klausler     }
363dfcccc6dSPeter Klausler     if (isEN) {
364dfcccc6dSPeter Klausler       // EN mode: we need an effective exponent field that is
365dfcccc6dSPeter Klausler       // a multiple of three.
366dfcccc6dSPeter Klausler       if (int modulus{converted.decimalExponent % 3}; modulus != 0) {
367dfcccc6dSPeter Klausler         if (significantDigits > 1) {
368dfcccc6dSPeter Klausler           --significantDigits;
369dfcccc6dSPeter Klausler           --scale;
3703b635714Speter klausler           continue;
3713b635714Speter klausler         }
372dfcccc6dSPeter Klausler         // Rounded nines up to a 1.
373dfcccc6dSPeter Klausler         scale += modulus;
374dfcccc6dSPeter Klausler         converted.decimalExponent -= modulus;
375dfcccc6dSPeter Klausler       }
376dfcccc6dSPeter Klausler       if (scale > 3) {
377dfcccc6dSPeter Klausler         int adjust{3 * (scale / 3)};
378dfcccc6dSPeter Klausler         scale -= adjust;
379dfcccc6dSPeter Klausler         converted.decimalExponent += adjust;
380dfcccc6dSPeter Klausler       } else if (scale < 1) {
381dfcccc6dSPeter Klausler         int adjust{3 - 3 * (scale / 3)};
382dfcccc6dSPeter Klausler         scale += adjust;
383dfcccc6dSPeter Klausler         converted.decimalExponent -= adjust;
384dfcccc6dSPeter Klausler       }
385dfcccc6dSPeter Klausler       significantDigits = editDigits + scale;
386dfcccc6dSPeter Klausler     }
3873b635714Speter klausler     // Format the exponent (see table 13.1 for all the cases)
3883b635714Speter klausler     int expoLength{0};
3893b635714Speter klausler     const char *exponent{
3903b635714Speter klausler         FormatExponent(converted.decimalExponent, edit, expoLength)};
3913b635714Speter klausler     int signLength{*converted.str == '-' || *converted.str == '+' ? 1 : 0};
3923b635714Speter klausler     int convertedDigits{static_cast<int>(converted.length) - signLength};
3933b635714Speter klausler     int zeroesBeforePoint{std::max(0, scale - convertedDigits)};
3943b635714Speter klausler     int digitsBeforePoint{std::max(0, scale - zeroesBeforePoint)};
3953b635714Speter klausler     int digitsAfterPoint{convertedDigits - digitsBeforePoint};
3963b635714Speter klausler     int trailingZeroes{flags & decimal::Minimize
3973b635714Speter klausler             ? 0
3983b635714Speter klausler             : std::max(0,
3993b635714Speter klausler                   significantDigits - (convertedDigits + zeroesBeforePoint))};
4003b635714Speter klausler     int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
4013b635714Speter klausler         1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
4023b635714Speter klausler         expoLength};
4033b635714Speter klausler     int width{editWidth > 0 ? editWidth : totalLength};
404db52dda8SPeter Klausler     if (totalLength > width || !exponent) {
405bad52055SPeter Klausler       return EmitRepeated(io_, '*', width);
4063b635714Speter klausler     }
4073b635714Speter klausler     if (totalLength < width && digitsBeforePoint == 0 &&
4083b635714Speter klausler         zeroesBeforePoint == 0) {
4093b635714Speter klausler       zeroesBeforePoint = 1;
4103b635714Speter klausler       ++totalLength;
4113b635714Speter klausler     }
412ea7e50cdSPeter Klausler     if (totalLength < width && editWidth == 0) {
4133f3edbe5SPeter Klausler       width = totalLength;
4143f3edbe5SPeter Klausler     }
4153b635714Speter klausler     return EmitPrefix(edit, totalLength, width) &&
416bad52055SPeter Klausler         EmitAscii(io_, converted.str, signLength + digitsBeforePoint) &&
417bad52055SPeter Klausler         EmitRepeated(io_, '0', zeroesBeforePoint) &&
418bad52055SPeter Klausler         EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
419bad52055SPeter Klausler         EmitRepeated(io_, '0', zeroesAfterPoint) &&
420bad52055SPeter Klausler         EmitAscii(io_, converted.str + signLength + digitsBeforePoint,
421bad52055SPeter Klausler             digitsAfterPoint) &&
422bad52055SPeter Klausler         EmitRepeated(io_, '0', trailingZeroes) &&
423bad52055SPeter Klausler         EmitAscii(io_, exponent, expoLength) && EmitSuffix(edit);
4243b635714Speter klausler   }
4253b635714Speter klausler }
4263b635714Speter klausler 
4273b635714Speter klausler // 13.7.2.3.2 in F'2018
428e593940bSPeter Klausler template <int KIND>
4298ebf7411SSlava Zakharin RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
4308cfdc32bSShao-Ce SUN   addSpaceBeforeCharacter(io_);
4313b635714Speter klausler   int fracDigits{edit.digits.value_or(0)}; // 'd' field
4320df6f8feSpeter klausler   const int editWidth{edit.width.value_or(0)}; // 'w' field
433d1b09adeSPeter Klausler   enum decimal::FortranRounding rounding{edit.modes.round};
4343b635714Speter klausler   int flags{0};
435d1b09adeSPeter Klausler   if (edit.modes.editingFlags & signPlus) {
436d1b09adeSPeter Klausler     flags |= decimal::AlwaysSign;
437d1b09adeSPeter Klausler   }
4383b635714Speter klausler   if (editWidth == 0) { // "the processor selects the field width"
4393b635714Speter klausler     if (!edit.digits.has_value()) { // F0
4403b635714Speter klausler       flags |= decimal::Minimize;
4413b635714Speter klausler       fracDigits = sizeof buffer_ - 2; // sign & NUL
4423b635714Speter klausler     }
4433b635714Speter klausler   }
444fa465b47SPeter Klausler   bool emitTrailingZeroes{!(flags & decimal::Minimize)};
4453b635714Speter klausler   // Multiple conversions may be needed to get the right number of
4463b635714Speter klausler   // effective rounded fractional digits.
4474876520eSpeter klausler   bool canIncrease{true};
448ced631e0SPeter Klausler   for (int extraDigits{fracDigits == 0 ? 1 : 0};;) {
4493b635714Speter klausler     decimal::ConversionToDecimalResult converted{
450ea7e50cdSPeter Klausler         ConvertToDecimal(extraDigits + fracDigits, rounding, flags)};
451ced631e0SPeter Klausler     const char *convertedStr{converted.str};
452ced631e0SPeter Klausler     if (IsInfOrNaN(convertedStr, static_cast<int>(converted.length))) {
453763e036cSPeter Klausler       return editWidth > 0 &&
454763e036cSPeter Klausler               converted.length > static_cast<std::size_t>(editWidth)
455763e036cSPeter Klausler           ? EmitRepeated(io_, '*', editWidth)
456763e036cSPeter Klausler           : EmitPrefix(edit, converted.length, editWidth) &&
457ced631e0SPeter Klausler               EmitAscii(io_, convertedStr, converted.length) &&
458763e036cSPeter Klausler               EmitSuffix(edit);
4593b635714Speter klausler     }
460724709e0SPeter Klausler     int expo{converted.decimalExponent + edit.modes.scale /*kP*/};
461ced631e0SPeter Klausler     int signLength{*convertedStr == '-' || *convertedStr == '+' ? 1 : 0};
462d1b09adeSPeter Klausler     int convertedDigits{static_cast<int>(converted.length) - signLength};
463724709e0SPeter Klausler     if (IsZero()) { // don't treat converted "0" as significant digit
464724709e0SPeter Klausler       expo = 0;
465724709e0SPeter Klausler       convertedDigits = 0;
466724709e0SPeter Klausler     }
467ced631e0SPeter Klausler     bool isNegative{*convertedStr == '-'};
468ced631e0SPeter Klausler     char one[2];
4694876520eSpeter klausler     if (expo > extraDigits && extraDigits >= 0 && canIncrease) {
4703b635714Speter klausler       extraDigits = expo;
4710df6f8feSpeter klausler       if (!edit.digits.has_value()) { // F0
4723b635714Speter klausler         fracDigits = sizeof buffer_ - extraDigits - 2; // sign & NUL
4733b635714Speter klausler       }
4744876520eSpeter klausler       canIncrease = false; // only once
4750df6f8feSpeter klausler       continue;
476d1b09adeSPeter Klausler     } else if (expo == -fracDigits && convertedDigits > 0) {
477ced631e0SPeter Klausler       // Result will be either a signed zero or power of ten, depending
478ced631e0SPeter Klausler       // on rounding.
479ced631e0SPeter Klausler       char leading{convertedStr[signLength]};
480ced631e0SPeter Klausler       bool roundToPowerOfTen{false};
481ced631e0SPeter Klausler       switch (edit.modes.round) {
482ced631e0SPeter Klausler       case decimal::FortranRounding::RoundUp:
483ced631e0SPeter Klausler         roundToPowerOfTen = !isNegative;
484ced631e0SPeter Klausler         break;
485ced631e0SPeter Klausler       case decimal::FortranRounding::RoundDown:
486ced631e0SPeter Klausler         roundToPowerOfTen = isNegative;
487ced631e0SPeter Klausler         break;
488ced631e0SPeter Klausler       case decimal::FortranRounding::RoundToZero:
489ced631e0SPeter Klausler         break;
490ced631e0SPeter Klausler       case decimal::FortranRounding::RoundNearest:
491ced631e0SPeter Klausler         if (leading == '5' &&
492ced631e0SPeter Klausler             rounding == decimal::FortranRounding::RoundNearest) {
493ced631e0SPeter Klausler           // Try again, rounding away from zero.
494ced631e0SPeter Klausler           rounding = isNegative ? decimal::FortranRounding::RoundDown
495ced631e0SPeter Klausler                                 : decimal::FortranRounding::RoundUp;
496ced631e0SPeter Klausler           extraDigits = 1 - fracDigits; // just one digit needed
497061df073SPeter Klausler           continue;
498ced631e0SPeter Klausler         }
499ced631e0SPeter Klausler         roundToPowerOfTen = leading > '5';
500ced631e0SPeter Klausler         break;
501ced631e0SPeter Klausler       case decimal::FortranRounding::RoundCompatible:
502ced631e0SPeter Klausler         roundToPowerOfTen = leading >= '5';
503ced631e0SPeter Klausler         break;
504ced631e0SPeter Klausler       }
505ced631e0SPeter Klausler       if (roundToPowerOfTen) {
506ced631e0SPeter Klausler         ++expo;
507ced631e0SPeter Klausler         convertedDigits = 1;
508ced631e0SPeter Klausler         if (signLength > 0) {
509ced631e0SPeter Klausler           one[0] = *convertedStr;
510ced631e0SPeter Klausler           one[1] = '1';
511d1b09adeSPeter Klausler         } else {
512ced631e0SPeter Klausler           one[0] = '1';
513ced631e0SPeter Klausler         }
514ced631e0SPeter Klausler         convertedStr = one;
515ced631e0SPeter Klausler       } else {
516d1b09adeSPeter Klausler         expo = 0;
517d1b09adeSPeter Klausler         convertedDigits = 0;
518d1b09adeSPeter Klausler       }
5190df6f8feSpeter klausler     } else if (expo < extraDigits && extraDigits > -fracDigits) {
5200df6f8feSpeter klausler       extraDigits = std::max(expo, -fracDigits);
5210df6f8feSpeter klausler       continue;
5223b635714Speter klausler     }
5233b635714Speter klausler     int digitsBeforePoint{std::max(0, std::min(expo, convertedDigits))};
5243b635714Speter klausler     int zeroesBeforePoint{std::max(0, expo - digitsBeforePoint)};
525fa465b47SPeter Klausler     if (zeroesBeforePoint > 0 && (flags & decimal::Minimize)) {
526fa465b47SPeter Klausler       // If a minimized result looks like an integer, emit all of
527fa465b47SPeter Klausler       // its digits rather than clipping some to zeroes.
528fa465b47SPeter Klausler       // This can happen with HUGE(0._2) == 65504._2.
529fa465b47SPeter Klausler       flags &= ~decimal::Minimize;
530fa465b47SPeter Klausler       continue;
531fa465b47SPeter Klausler     }
5320df6f8feSpeter klausler     int zeroesAfterPoint{std::min(fracDigits, std::max(0, -expo))};
5333b635714Speter klausler     int digitsAfterPoint{convertedDigits - digitsBeforePoint};
534fa465b47SPeter Klausler     int trailingZeroes{emitTrailingZeroes
535fa465b47SPeter Klausler             ? std::max(0, fracDigits - (zeroesAfterPoint + digitsAfterPoint))
536fa465b47SPeter Klausler             : 0};
5373b635714Speter klausler     if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint +
538ced631e0SPeter Klausler             digitsAfterPoint + trailingZeroes ==
5393b635714Speter klausler         0) {
5400df6f8feSpeter klausler       zeroesBeforePoint = 1; // "." -> "0."
5413b635714Speter klausler     }
5423b635714Speter klausler     int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
543933882f7SPeter Klausler         1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
544933882f7SPeter Klausler         trailingBlanks_ /* G editing converted to F */};
545933882f7SPeter Klausler     int width{editWidth > 0 || trailingBlanks_ ? editWidth : totalLength};
5463b635714Speter klausler     if (totalLength > width) {
547bad52055SPeter Klausler       return EmitRepeated(io_, '*', width);
5483b635714Speter klausler     }
5493b635714Speter klausler     if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
5503b635714Speter klausler       zeroesBeforePoint = 1;
5513b635714Speter klausler       ++totalLength;
5523b635714Speter klausler     }
5533b635714Speter klausler     return EmitPrefix(edit, totalLength, width) &&
554ced631e0SPeter Klausler         EmitAscii(io_, convertedStr, signLength + digitsBeforePoint) &&
555bad52055SPeter Klausler         EmitRepeated(io_, '0', zeroesBeforePoint) &&
556bad52055SPeter Klausler         EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
557bad52055SPeter Klausler         EmitRepeated(io_, '0', zeroesAfterPoint) &&
558ced631e0SPeter Klausler         EmitAscii(io_, convertedStr + signLength + digitsBeforePoint,
559bad52055SPeter Klausler             digitsAfterPoint) &&
560bad52055SPeter Klausler         EmitRepeated(io_, '0', trailingZeroes) &&
561bad52055SPeter Klausler         EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit);
5623b635714Speter klausler   }
5633b635714Speter klausler }
5643b635714Speter klausler 
5653b635714Speter klausler // 13.7.5.2.3 in F'2018
566e593940bSPeter Klausler template <int KIND>
5678ebf7411SSlava Zakharin RT_API_ATTRS DataEdit RealOutputEditing<KIND>::EditForGOutput(DataEdit edit) {
5683b635714Speter klausler   edit.descriptor = 'E';
569033b491cSPeter Klausler   edit.variation = 'G'; // to suppress error for Ew.0
5703f3edbe5SPeter Klausler   int editWidth{edit.width.value_or(0)};
5718ebf7411SSlava Zakharin   int significantDigits{edit.digits.value_or(
5728ebf7411SSlava Zakharin       static_cast<int>(BinaryFloatingPoint::decimalPrecision))}; // 'd'
5733f3edbe5SPeter Klausler   if (editWidth > 0 && significantDigits == 0) {
574df6afee9SPeter Klausler     return edit; // Gw.0Ee -> Ew.0Ee for w > 0
5753b635714Speter klausler   }
576d1b09adeSPeter Klausler   int flags{0};
577d1b09adeSPeter Klausler   if (edit.modes.editingFlags & signPlus) {
578d1b09adeSPeter Klausler     flags |= decimal::AlwaysSign;
579d1b09adeSPeter Klausler   }
5804fb679d3Speter klausler   decimal::ConversionToDecimalResult converted{
581ea7e50cdSPeter Klausler       ConvertToDecimal(significantDigits, edit.modes.round, flags)};
582ea7e50cdSPeter Klausler   if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
5833f3edbe5SPeter Klausler     return edit; // Inf/Nan -> Ew.d (same as Fw.d)
5843b635714Speter klausler   }
5853b635714Speter klausler   int expo{IsZero() ? 1 : converted.decimalExponent}; // 's'
5863b635714Speter klausler   if (expo < 0 || expo > significantDigits) {
587df6afee9SPeter Klausler     if (editWidth == 0 && !edit.expoDigits) { // G0.d -> G0.dE0
588df6afee9SPeter Klausler       edit.expoDigits = 0;
589df6afee9SPeter Klausler     }
590df6afee9SPeter Klausler     return edit; // Ew.dEe
5913b635714Speter klausler   }
5923b635714Speter klausler   edit.descriptor = 'F';
5933b635714Speter klausler   edit.modes.scale = 0; // kP is ignored for G when no exponent field
5943b635714Speter klausler   trailingBlanks_ = 0;
5953b635714Speter klausler   if (editWidth > 0) {
5963b635714Speter klausler     int expoDigits{edit.expoDigits.value_or(0)};
597933882f7SPeter Klausler     // F'2023 13.7.5.2.3 p5: "If 0 <= s <= d, the scale factor has no effect
598933882f7SPeter Klausler     // and F(w − n).(d − s),n(’b’) editing is used where b is a blank and
599933882f7SPeter Klausler     // n is 4 for Gw.d editing, e + 2 for Gw.dEe editing if e > 0, and
600933882f7SPeter Klausler     // 4 for Gw.dE0 editing."
6013b635714Speter klausler     trailingBlanks_ = expoDigits > 0 ? expoDigits + 2 : 4; // 'n'
6023b635714Speter klausler   }
6033b635714Speter klausler   if (edit.digits.has_value()) {
6043b635714Speter klausler     *edit.digits = std::max(0, *edit.digits - expo);
6053b635714Speter klausler   }
6063b635714Speter klausler   return edit;
6073b635714Speter klausler }
6083b635714Speter klausler 
6093b635714Speter klausler // 13.10.4 in F'2018
610e593940bSPeter Klausler template <int KIND>
6118ebf7411SSlava Zakharin RT_API_ATTRS bool RealOutputEditing<KIND>::EditListDirectedOutput(
6128ebf7411SSlava Zakharin     const DataEdit &edit) {
613ea7e50cdSPeter Klausler   decimal::ConversionToDecimalResult converted{
614ea7e50cdSPeter Klausler       ConvertToDecimal(1, edit.modes.round)};
615ea7e50cdSPeter Klausler   if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
616033b491cSPeter Klausler     DataEdit copy{edit};
617033b491cSPeter Klausler     copy.variation = DataEdit::ListDirected;
618033b491cSPeter Klausler     return EditEorDOutput(copy);
6193b635714Speter klausler   }
6203b635714Speter klausler   int expo{converted.decimalExponent};
621faffcc3aSPeter Klausler   // The decimal precision of 16-bit floating-point types is very low,
622faffcc3aSPeter Klausler   // so use a reasonable cap of 6 to allow more values to be emitted
623faffcc3aSPeter Klausler   // with Fw.d editing.
624faffcc3aSPeter Klausler   static constexpr int maxExpo{
625faffcc3aSPeter Klausler       std::max(6, BinaryFloatingPoint::decimalPrecision)};
626faffcc3aSPeter Klausler   if (expo < 0 || expo > maxExpo) {
6273b635714Speter klausler     DataEdit copy{edit};
628033b491cSPeter Klausler     copy.variation = DataEdit::ListDirected;
6293b635714Speter klausler     copy.modes.scale = 1; // 1P
6303b635714Speter klausler     return EditEorDOutput(copy);
631033b491cSPeter Klausler   } else {
6323b635714Speter klausler     return EditFOutput(edit);
6333b635714Speter klausler   }
634033b491cSPeter Klausler }
6353b635714Speter klausler 
636ea7e50cdSPeter Klausler // 13.7.2.3.6 in F'2023
637ea7e50cdSPeter Klausler // The specification for hexadecimal output, unfortunately for implementors,
638ea7e50cdSPeter Klausler // leaves as "implementation dependent" the choice of how to emit values
639ea7e50cdSPeter Klausler // with multiple hexadecimal output possibilities that are numerically
640ea7e50cdSPeter Klausler // equivalent.  The one working implementation of EX output that I can find
641ea7e50cdSPeter Klausler // apparently chooses to frame the nybbles from most to least significant,
642ea7e50cdSPeter Klausler // rather than trying to minimize the magnitude of the binary exponent.
643ea7e50cdSPeter Klausler // E.g., 2. is edited into 0X8.0P-2 rather than 0X2.0P0.  This implementation
644ea7e50cdSPeter Klausler // follows that precedent so as to avoid a gratuitous incompatibility.
645e593940bSPeter Klausler template <int KIND>
6468ebf7411SSlava Zakharin RT_API_ATTRS auto RealOutputEditing<KIND>::ConvertToHexadecimal(
6478ebf7411SSlava Zakharin     int significantDigits, enum decimal::FortranRounding rounding,
6488ebf7411SSlava Zakharin     int flags) -> ConvertToHexadecimalResult {
649ea7e50cdSPeter Klausler   if (x_.IsNaN() || x_.IsInfinite()) {
650ea7e50cdSPeter Klausler     auto converted{ConvertToDecimal(significantDigits, rounding, flags)};
651ea7e50cdSPeter Klausler     return {converted.str, static_cast<int>(converted.length), 0};
652ea7e50cdSPeter Klausler   }
653ea7e50cdSPeter Klausler   x_.RoundToBits(4 * significantDigits, rounding);
654ea7e50cdSPeter Klausler   if (x_.IsInfinite()) { // rounded away to +/-Inf
655ea7e50cdSPeter Klausler     auto converted{ConvertToDecimal(significantDigits, rounding, flags)};
656ea7e50cdSPeter Klausler     return {converted.str, static_cast<int>(converted.length), 0};
657ea7e50cdSPeter Klausler   }
658ea7e50cdSPeter Klausler   int len{0};
659ea7e50cdSPeter Klausler   if (x_.IsNegative()) {
660ea7e50cdSPeter Klausler     buffer_[len++] = '-';
661ea7e50cdSPeter Klausler   } else if (flags & decimal::AlwaysSign) {
662ea7e50cdSPeter Klausler     buffer_[len++] = '+';
663ea7e50cdSPeter Klausler   }
664ea7e50cdSPeter Klausler   auto fraction{x_.Fraction()};
665ea7e50cdSPeter Klausler   if (fraction == 0) {
666ea7e50cdSPeter Klausler     buffer_[len++] = '0';
667ea7e50cdSPeter Klausler     return {buffer_, len, 0};
668ea7e50cdSPeter Klausler   } else {
669ea7e50cdSPeter Klausler     // Ensure that the MSB is set.
670ea7e50cdSPeter Klausler     int expo{x_.UnbiasedExponent() - 3};
671ea7e50cdSPeter Klausler     while (!(fraction >> (x_.binaryPrecision - 1))) {
672ea7e50cdSPeter Klausler       fraction <<= 1;
673ea7e50cdSPeter Klausler       --expo;
674ea7e50cdSPeter Klausler     }
675ea7e50cdSPeter Klausler     // This is initially the right shift count needed to bring the
676ea7e50cdSPeter Klausler     // most-significant hexadecimal digit's bits into the LSBs.
677ea7e50cdSPeter Klausler     // x_.binaryPrecision is constant, so / can be used for readability.
678ea7e50cdSPeter Klausler     int shift{x_.binaryPrecision - 4};
679ea7e50cdSPeter Klausler     typename BinaryFloatingPoint::RawType one{1};
68014e221aaSPeter Klausler     auto remaining{(one << x_.binaryPrecision) - one};
681ea7e50cdSPeter Klausler     for (int digits{0}; digits < significantDigits; ++digits) {
682ea7e50cdSPeter Klausler       if ((flags & decimal::Minimize) && !(fraction & remaining)) {
683ea7e50cdSPeter Klausler         break;
684ea7e50cdSPeter Klausler       }
685ea7e50cdSPeter Klausler       int hexDigit{0};
686ea7e50cdSPeter Klausler       if (shift >= 0) {
687ea7e50cdSPeter Klausler         hexDigit = int(fraction >> shift) & 0xf;
688ea7e50cdSPeter Klausler       } else if (shift >= -3) {
689ea7e50cdSPeter Klausler         hexDigit = int(fraction << -shift) & 0xf;
690ea7e50cdSPeter Klausler       }
691ea7e50cdSPeter Klausler       if (hexDigit >= 10) {
692ea7e50cdSPeter Klausler         buffer_[len++] = 'A' + hexDigit - 10;
693ea7e50cdSPeter Klausler       } else {
694ea7e50cdSPeter Klausler         buffer_[len++] = '0' + hexDigit;
695ea7e50cdSPeter Klausler       }
696ea7e50cdSPeter Klausler       shift -= 4;
697ea7e50cdSPeter Klausler       remaining >>= 4;
698ea7e50cdSPeter Klausler     }
699ea7e50cdSPeter Klausler     return {buffer_, len, expo};
700ea7e50cdSPeter Klausler   }
701ea7e50cdSPeter Klausler }
702ea7e50cdSPeter Klausler 
703ea7e50cdSPeter Klausler template <int KIND>
7048ebf7411SSlava Zakharin RT_API_ATTRS bool RealOutputEditing<KIND>::EditEXOutput(const DataEdit &edit) {
705ea7e50cdSPeter Klausler   addSpaceBeforeCharacter(io_);
706ea7e50cdSPeter Klausler   int editDigits{edit.digits.value_or(0)}; // 'd' field
707ea7e50cdSPeter Klausler   int significantDigits{editDigits + 1};
708ea7e50cdSPeter Klausler   int flags{0};
709ea7e50cdSPeter Klausler   if (edit.modes.editingFlags & signPlus) {
710ea7e50cdSPeter Klausler     flags |= decimal::AlwaysSign;
711ea7e50cdSPeter Klausler   }
712ea7e50cdSPeter Klausler   int editWidth{edit.width.value_or(0)}; // 'w' field
71314e221aaSPeter Klausler   if ((editWidth == 0 && !edit.digits) || editDigits == 0) {
71414e221aaSPeter Klausler     // EX0 or EXw.0
715ea7e50cdSPeter Klausler     flags |= decimal::Minimize;
7165e21fa23SPeter Klausler     static constexpr int maxSigHexDigits{
7175e21fa23SPeter Klausler         (common::PrecisionOfRealKind(16) + 3) / 4};
7185e21fa23SPeter Klausler     significantDigits = maxSigHexDigits;
719ea7e50cdSPeter Klausler   }
720ea7e50cdSPeter Klausler   auto converted{
721ea7e50cdSPeter Klausler       ConvertToHexadecimal(significantDigits, edit.modes.round, flags)};
722ea7e50cdSPeter Klausler   if (IsInfOrNaN(converted.str, converted.length)) {
723ea7e50cdSPeter Klausler     return editWidth > 0 && converted.length > editWidth
724ea7e50cdSPeter Klausler         ? EmitRepeated(io_, '*', editWidth)
725ea7e50cdSPeter Klausler         : (editWidth <= converted.length ||
726ea7e50cdSPeter Klausler               EmitRepeated(io_, ' ', editWidth - converted.length)) &&
727ea7e50cdSPeter Klausler             EmitAscii(io_, converted.str, converted.length);
728ea7e50cdSPeter Klausler   }
729ea7e50cdSPeter Klausler   int signLength{converted.length > 0 &&
730ea7e50cdSPeter Klausler               (converted.str[0] == '-' || converted.str[0] == '+')
731ea7e50cdSPeter Klausler           ? 1
732ea7e50cdSPeter Klausler           : 0};
733ea7e50cdSPeter Klausler   int convertedDigits{converted.length - signLength};
734ea7e50cdSPeter Klausler   int expoLength{0};
735ea7e50cdSPeter Klausler   const char *exponent{FormatExponent(converted.exponent, edit, expoLength)};
736ea7e50cdSPeter Klausler   int trailingZeroes{flags & decimal::Minimize
737ea7e50cdSPeter Klausler           ? 0
738ea7e50cdSPeter Klausler           : std::max(0, significantDigits - convertedDigits)};
739ea7e50cdSPeter Klausler   int totalLength{converted.length + trailingZeroes + expoLength + 3 /*0X.*/};
740ea7e50cdSPeter Klausler   int width{editWidth > 0 ? editWidth : totalLength};
741ea7e50cdSPeter Klausler   return totalLength > width || !exponent
742ea7e50cdSPeter Klausler       ? EmitRepeated(io_, '*', width)
743ea7e50cdSPeter Klausler       : EmitRepeated(io_, ' ', width - totalLength) &&
744ea7e50cdSPeter Klausler           EmitAscii(io_, converted.str, signLength) &&
745ea7e50cdSPeter Klausler           EmitAscii(io_, "0X", 2) &&
746ea7e50cdSPeter Klausler           EmitAscii(io_, converted.str + signLength, 1) &&
747ea7e50cdSPeter Klausler           EmitAscii(
748ea7e50cdSPeter Klausler               io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
749ea7e50cdSPeter Klausler           EmitAscii(io_, converted.str + signLength + 1,
750ea7e50cdSPeter Klausler               converted.length - (signLength + 1)) &&
751ea7e50cdSPeter Klausler           EmitRepeated(io_, '0', trailingZeroes) &&
752ea7e50cdSPeter Klausler           EmitAscii(io_, exponent, expoLength);
7533b635714Speter klausler }
7543b635714Speter klausler 
7558ebf7411SSlava Zakharin template <int KIND>
7568ebf7411SSlava Zakharin RT_API_ATTRS bool RealOutputEditing<KIND>::Edit(const DataEdit &edit) {
7572b86fb21SSlava Zakharin   const DataEdit *editPtr{&edit};
7582b86fb21SSlava Zakharin   DataEdit newEdit;
7592b86fb21SSlava Zakharin   if (editPtr->descriptor == 'G') {
7602b86fb21SSlava Zakharin     // Avoid recursive call as in Edit(EditForGOutput(edit)).
7612b86fb21SSlava Zakharin     newEdit = EditForGOutput(*editPtr);
7622b86fb21SSlava Zakharin     editPtr = &newEdit;
7632b86fb21SSlava Zakharin     RUNTIME_CHECK(io_.GetIoErrorHandler(), editPtr->descriptor != 'G');
7642b86fb21SSlava Zakharin   }
7652b86fb21SSlava Zakharin   switch (editPtr->descriptor) {
7661f879005STim Keith   case 'D':
7672b86fb21SSlava Zakharin     return EditEorDOutput(*editPtr);
7683b635714Speter klausler   case 'E':
7692b86fb21SSlava Zakharin     if (editPtr->variation == 'X') {
7702b86fb21SSlava Zakharin       return EditEXOutput(*editPtr);
7713b635714Speter klausler     } else {
7722b86fb21SSlava Zakharin       return EditEorDOutput(*editPtr);
7733b635714Speter klausler     }
7741f879005STim Keith   case 'F':
7752b86fb21SSlava Zakharin     return EditFOutput(*editPtr);
7763b635714Speter klausler   case 'B':
7772b86fb21SSlava Zakharin     return EditBOZOutput<1>(io_, *editPtr,
77853f775bbSPeter Klausler         reinterpret_cast<const unsigned char *>(&x_),
77953f775bbSPeter Klausler         common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
7803b635714Speter klausler   case 'O':
7812b86fb21SSlava Zakharin     return EditBOZOutput<3>(io_, *editPtr,
78253f775bbSPeter Klausler         reinterpret_cast<const unsigned char *>(&x_),
78353f775bbSPeter Klausler         common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
7843b635714Speter klausler   case 'Z':
7852b86fb21SSlava Zakharin     return EditBOZOutput<4>(io_, *editPtr,
78653f775bbSPeter Klausler         reinterpret_cast<const unsigned char *>(&x_),
78753f775bbSPeter Klausler         common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
78877d667b1SShao-Ce SUN   case 'L':
7892b86fb21SSlava Zakharin     return EditLogicalOutput(
7902b86fb21SSlava Zakharin         io_, *editPtr, *reinterpret_cast<const char *>(&x_));
791b83242e2Speter klausler   case 'A': // legacy extension
792bafbae23SPeter Klausler     return EditCharacterOutput(
7932b86fb21SSlava Zakharin         io_, *editPtr, reinterpret_cast<char *>(&x_), sizeof x_);
7943b635714Speter klausler   default:
7952b86fb21SSlava Zakharin     if (editPtr->IsListDirected()) {
7962b86fb21SSlava Zakharin       return EditListDirectedOutput(*editPtr);
7973b635714Speter klausler     }
7983b635714Speter klausler     io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
7993b635714Speter klausler         "Data edit descriptor '%c' may not be used with a REAL data item",
8002b86fb21SSlava Zakharin         editPtr->descriptor);
8013b635714Speter klausler     return false;
8023b635714Speter klausler   }
8033b635714Speter klausler   return false;
8043b635714Speter klausler }
8053b635714Speter klausler 
8068ebf7411SSlava Zakharin RT_API_ATTRS bool ListDirectedLogicalOutput(IoStatementState &io,
8073b635714Speter klausler     ListDirectedStatementState<Direction::Output> &list, bool truth) {
808bad52055SPeter Klausler   return list.EmitLeadingSpaceOrAdvance(io) &&
809bad52055SPeter Klausler       EmitAscii(io, truth ? "T" : "F", 1);
8103b635714Speter klausler }
8113b635714Speter klausler 
8128ebf7411SSlava Zakharin RT_API_ATTRS bool EditLogicalOutput(
8138ebf7411SSlava Zakharin     IoStatementState &io, const DataEdit &edit, bool truth) {
8143b635714Speter klausler   switch (edit.descriptor) {
8153b635714Speter klausler   case 'L':
8161f879005STim Keith   case 'G':
817bad52055SPeter Klausler     return EmitRepeated(io, ' ', std::max(0, edit.width.value_or(1) - 1)) &&
818bad52055SPeter Klausler         EmitAscii(io, truth ? "T" : "F", 1);
81953f775bbSPeter Klausler   case 'B':
82053f775bbSPeter Klausler     return EditBOZOutput<1>(io, edit,
82153f775bbSPeter Klausler         reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
82253f775bbSPeter Klausler   case 'O':
82353f775bbSPeter Klausler     return EditBOZOutput<3>(io, edit,
82453f775bbSPeter Klausler         reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
82553f775bbSPeter Klausler   case 'Z':
82653f775bbSPeter Klausler     return EditBOZOutput<4>(io, edit,
82753f775bbSPeter Klausler         reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
8286fd475feSPeter Klausler   case 'A': { // legacy extension
8296fd475feSPeter Klausler     int truthBits{truth};
83093540455SSlava Zakharin     int len{sizeof truthBits};
83193540455SSlava Zakharin     int width{edit.width.value_or(len)};
83293540455SSlava Zakharin     return EmitRepeated(io, ' ', std::max(0, width - len)) &&
83393540455SSlava Zakharin         EmitEncoded(
83493540455SSlava Zakharin             io, reinterpret_cast<char *>(&truthBits), std::min(width, len));
8356fd475feSPeter Klausler   }
8363b635714Speter klausler   default:
8373b635714Speter klausler     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
8383b635714Speter klausler         "Data edit descriptor '%c' may not be used with a LOGICAL data item",
8393b635714Speter klausler         edit.descriptor);
8403b635714Speter klausler     return false;
8413b635714Speter klausler   }
8423b635714Speter klausler }
8433b635714Speter klausler 
844bafbae23SPeter Klausler template <typename CHAR>
8458ebf7411SSlava Zakharin RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &io,
846bafbae23SPeter Klausler     ListDirectedStatementState<Direction::Output> &list, const CHAR *x,
8473b635714Speter klausler     std::size_t length) {
8486a1c3efaSpeter klausler   bool ok{true};
8493b635714Speter klausler   MutableModes &modes{io.mutableModes()};
8503b635714Speter klausler   ConnectionState &connection{io.GetConnectionState()};
8513b635714Speter klausler   if (modes.delim) {
8526a1c3efaSpeter klausler     ok = ok && list.EmitLeadingSpaceOrAdvance(io);
8533b635714Speter klausler     // Value is delimited with ' or " marks, and interior
8544d42e16eSpeter klausler     // instances of that character are doubled.
855bafbae23SPeter Klausler     auto EmitOne{[&](CHAR ch) {
8564d42e16eSpeter klausler       if (connection.NeedAdvance(1)) {
8574d42e16eSpeter klausler         ok = ok && io.AdvanceRecord();
8584d42e16eSpeter klausler       }
859bad52055SPeter Klausler       ok = ok && EmitEncoded(io, &ch, 1);
8604d42e16eSpeter klausler     }};
8613a96446dSPeter Klausler     EmitOne(modes.delim);
8623b635714Speter klausler     for (std::size_t j{0}; j < length; ++j) {
8634d42e16eSpeter klausler       // Doubled delimiters must be put on the same record
8644d42e16eSpeter klausler       // in order to be acceptable as list-directed or NAMELIST
8654d42e16eSpeter klausler       // input; however, this requirement is not always possible
8664d42e16eSpeter klausler       // when the records have a fixed length, as is the case with
8674d42e16eSpeter klausler       // internal output.  The standard is silent on what should
8684d42e16eSpeter klausler       // happen, and no two extant Fortran implementations do
8694d42e16eSpeter klausler       // the same thing when tested with this case.
8704d42e16eSpeter klausler       // This runtime splits the doubled delimiters across
8714d42e16eSpeter klausler       // two records for lack of a better alternative.
872bafbae23SPeter Klausler       if (x[j] == static_cast<CHAR>(modes.delim)) {
8734d42e16eSpeter klausler         EmitOne(x[j]);
8743b635714Speter klausler       }
8754d42e16eSpeter klausler       EmitOne(x[j]);
8763b635714Speter klausler     }
8774d42e16eSpeter klausler     EmitOne(modes.delim);
8783b635714Speter klausler   } else {
8793b635714Speter klausler     // Undelimited list-directed output
8803a96446dSPeter Klausler     ok = ok && list.EmitLeadingSpaceOrAdvance(io, length > 0 ? 1 : 0, true);
8813b635714Speter klausler     std::size_t put{0};
882bad52055SPeter Klausler     std::size_t oneAtATime{
883bad52055SPeter Klausler         connection.useUTF8<CHAR>() || connection.internalIoCharKind > 1
884bad52055SPeter Klausler             ? 1
885bad52055SPeter Klausler             : length};
8866a1c3efaSpeter klausler     while (ok && put < length) {
887bafbae23SPeter Klausler       if (std::size_t chunk{std::min<std::size_t>(
888bad52055SPeter Klausler               std::min<std::size_t>(length - put, oneAtATime),
889bafbae23SPeter Klausler               connection.RemainingSpaceInRecord())}) {
890bad52055SPeter Klausler         ok = EmitEncoded(io, x + put, chunk);
8913b635714Speter klausler         put += chunk;
892bafbae23SPeter Klausler       } else {
893bad52055SPeter Klausler         ok = io.AdvanceRecord() && EmitAscii(io, " ", 1);
8943b635714Speter klausler       }
8953b635714Speter klausler     }
8966a1c3efaSpeter klausler     list.set_lastWasUndelimitedCharacter(true);
8973b635714Speter klausler   }
8983b635714Speter klausler   return ok;
8993b635714Speter klausler }
9003b635714Speter klausler 
901bafbae23SPeter Klausler template <typename CHAR>
9028ebf7411SSlava Zakharin RT_API_ATTRS bool EditCharacterOutput(IoStatementState &io,
9038ebf7411SSlava Zakharin     const DataEdit &edit, const CHAR *x, std::size_t length) {
90428b5e99aSPeter Klausler   int len{static_cast<int>(length)};
90528b5e99aSPeter Klausler   int width{edit.width.value_or(len)};
9063b635714Speter klausler   switch (edit.descriptor) {
9073b635714Speter klausler   case 'A':
90828b5e99aSPeter Klausler     break;
9091f879005STim Keith   case 'G':
91028b5e99aSPeter Klausler     if (width == 0) {
91128b5e99aSPeter Klausler       width = len;
91228b5e99aSPeter Klausler     }
9131f879005STim Keith     break;
91453f775bbSPeter Klausler   case 'B':
91553f775bbSPeter Klausler     return EditBOZOutput<1>(io, edit,
91653f775bbSPeter Klausler         reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
91753f775bbSPeter Klausler   case 'O':
91853f775bbSPeter Klausler     return EditBOZOutput<3>(io, edit,
91953f775bbSPeter Klausler         reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
92053f775bbSPeter Klausler   case 'Z':
92153f775bbSPeter Klausler     return EditBOZOutput<4>(io, edit,
92253f775bbSPeter Klausler         reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
92377d667b1SShao-Ce SUN   case 'L':
92477d667b1SShao-Ce SUN     return EditLogicalOutput(io, edit, *reinterpret_cast<const char *>(x));
9253b635714Speter klausler   default:
9263b635714Speter klausler     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
9273b635714Speter klausler         "Data edit descriptor '%c' may not be used with a CHARACTER data item",
9283b635714Speter klausler         edit.descriptor);
9293b635714Speter klausler     return false;
9303b635714Speter klausler   }
931bad52055SPeter Klausler   return EmitRepeated(io, ' ', std::max(0, width - len)) &&
932bad52055SPeter Klausler       EmitEncoded(io, x, std::min(width, len));
9333b635714Speter klausler }
9343b635714Speter klausler 
9358ebf7411SSlava Zakharin template RT_API_ATTRS bool EditIntegerOutput<1>(
936*fc97d2e6SPeter Klausler     IoStatementState &, const DataEdit &, std::int8_t, bool);
9378ebf7411SSlava Zakharin template RT_API_ATTRS bool EditIntegerOutput<2>(
938*fc97d2e6SPeter Klausler     IoStatementState &, const DataEdit &, std::int16_t, bool);
9398ebf7411SSlava Zakharin template RT_API_ATTRS bool EditIntegerOutput<4>(
940*fc97d2e6SPeter Klausler     IoStatementState &, const DataEdit &, std::int32_t, bool);
9418ebf7411SSlava Zakharin template RT_API_ATTRS bool EditIntegerOutput<8>(
942*fc97d2e6SPeter Klausler     IoStatementState &, const DataEdit &, std::int64_t, bool);
9438ebf7411SSlava Zakharin template RT_API_ATTRS bool EditIntegerOutput<16>(
944*fc97d2e6SPeter Klausler     IoStatementState &, const DataEdit &, common::int128_t, bool);
9453b635714Speter klausler 
946d56fdc8eSpeter klausler template class RealOutputEditing<2>;
947d56fdc8eSpeter klausler template class RealOutputEditing<3>;
948d56fdc8eSpeter klausler template class RealOutputEditing<4>;
9493b635714Speter klausler template class RealOutputEditing<8>;
950d56fdc8eSpeter klausler template class RealOutputEditing<10>;
951d56fdc8eSpeter klausler // TODO: double/double
952d56fdc8eSpeter klausler template class RealOutputEditing<16>;
953bafbae23SPeter Klausler 
9548ebf7411SSlava Zakharin template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
955bafbae23SPeter Klausler     ListDirectedStatementState<Direction::Output> &, const char *,
956bafbae23SPeter Klausler     std::size_t chars);
9578ebf7411SSlava Zakharin template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
958bafbae23SPeter Klausler     ListDirectedStatementState<Direction::Output> &, const char16_t *,
959bafbae23SPeter Klausler     std::size_t chars);
9608ebf7411SSlava Zakharin template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
961bafbae23SPeter Klausler     ListDirectedStatementState<Direction::Output> &, const char32_t *,
962bafbae23SPeter Klausler     std::size_t chars);
963bafbae23SPeter Klausler 
9648ebf7411SSlava Zakharin template RT_API_ATTRS bool EditCharacterOutput(
965bafbae23SPeter Klausler     IoStatementState &, const DataEdit &, const char *, std::size_t chars);
9668ebf7411SSlava Zakharin template RT_API_ATTRS bool EditCharacterOutput(
967bafbae23SPeter Klausler     IoStatementState &, const DataEdit &, const char16_t *, std::size_t chars);
9688ebf7411SSlava Zakharin template RT_API_ATTRS bool EditCharacterOutput(
969bafbae23SPeter Klausler     IoStatementState &, const DataEdit &, const char32_t *, std::size_t chars);
970bafbae23SPeter Klausler 
9718ebf7411SSlava Zakharin RT_OFFLOAD_API_GROUP_END
9721f879005STim Keith } // namespace Fortran::runtime::io
973