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