//===-- runtime/edit-output.cpp -------------------------------------------===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// #include "edit-output.h" #include "emit-encoded.h" #include "utf.h" #include "flang/Common/real.h" #include "flang/Common/uint128.h" #include namespace Fortran::runtime::io { RT_OFFLOAD_API_GROUP_BEGIN // In output statement, add a space between numbers and characters. static RT_API_ATTRS void addSpaceBeforeCharacter(IoStatementState &io) { if (auto *list{io.get_if>()}) { list->set_lastWasUndelimitedCharacter(false); } } // B/O/Z output of arbitrarily sized data emits a binary/octal/hexadecimal // representation of what is interpreted to be a single unsigned integer value. // When used with character data, endianness is exposed. template static RT_API_ATTRS bool EditBOZOutput(IoStatementState &io, const DataEdit &edit, const unsigned char *data0, std::size_t bytes) { addSpaceBeforeCharacter(io); int digits{static_cast((bytes * 8) / LOG2_BASE)}; int get{static_cast(bytes * 8) - digits * LOG2_BASE}; if (get > 0) { ++digits; } else { get = LOG2_BASE; } int shift{7}; int increment{isHostLittleEndian ? -1 : 1}; const unsigned char *data{data0 + (isHostLittleEndian ? bytes - 1 : 0)}; int skippedZeroes{0}; int digit{0}; // The same algorithm is used to generate digits for real (below) // as well as for generating them only to skip leading zeroes (here). // Bits are copied one at a time from the source data. // TODO: Multiple bit copies for hexadecimal, where misalignment // is not possible; or for octal when all 3 bits come from the // same byte. while (bytes > 0) { if (get == 0) { if (digit != 0) { break; // first nonzero leading digit } ++skippedZeroes; get = LOG2_BASE; } else if (shift < 0) { data += increment; --bytes; shift = 7; } else { digit = 2 * digit + ((*data >> shift--) & 1); --get; } } // Emit leading spaces and zeroes; detect field overflow int leadingZeroes{0}; int editWidth{edit.width.value_or(0)}; int significant{digits - skippedZeroes}; if (edit.digits && significant <= *edit.digits) { // Bw.m, Ow.m, Zw.m if (*edit.digits == 0 && bytes == 0) { editWidth = std::max(1, editWidth); } else { leadingZeroes = *edit.digits - significant; } } else if (bytes == 0) { leadingZeroes = 1; } int subTotal{leadingZeroes + significant}; int leadingSpaces{std::max(0, editWidth - subTotal)}; if (editWidth > 0 && leadingSpaces + subTotal > editWidth) { return EmitRepeated(io, '*', editWidth); } if (!(EmitRepeated(io, ' ', leadingSpaces) && EmitRepeated(io, '0', leadingZeroes))) { return false; } // Emit remaining digits while (bytes > 0) { if (get == 0) { char ch{static_cast(digit >= 10 ? 'A' + digit - 10 : '0' + digit)}; if (!EmitAscii(io, &ch, 1)) { return false; } get = LOG2_BASE; digit = 0; } else if (shift < 0) { data += increment; --bytes; shift = 7; } else { digit = 2 * digit + ((*data >> shift--) & 1); --get; } } return true; } template bool RT_API_ATTRS EditIntegerOutput(IoStatementState &io, const DataEdit &edit, common::HostSignedIntType<8 * KIND> n, bool isSigned) { addSpaceBeforeCharacter(io); char buffer[130], *end{&buffer[sizeof buffer]}, *p{end}; bool isNegative{isSigned && n < 0}; using Unsigned = common::HostUnsignedIntType<8 * KIND>; Unsigned un{static_cast(n)}; int signChars{0}; switch (edit.descriptor) { case DataEdit::ListDirected: case 'G': case 'I': if (isNegative) { un = -un; } if (isNegative || (edit.modes.editingFlags & signPlus)) { signChars = 1; // '-' or '+' } while (un > 0) { auto quotient{un / 10u}; *--p = '0' + static_cast(un - Unsigned{10} * quotient); un = quotient; } break; case 'B': return EditBOZOutput<1>( io, edit, reinterpret_cast(&n), KIND); case 'O': return EditBOZOutput<3>( io, edit, reinterpret_cast(&n), KIND); case 'Z': return EditBOZOutput<4>( io, edit, reinterpret_cast(&n), KIND); case 'L': return EditLogicalOutput(io, edit, n != 0 ? true : false); case 'A': // legacy extension return EditCharacterOutput( io, edit, reinterpret_cast(&n), sizeof n); default: io.GetIoErrorHandler().SignalError(IostatErrorInFormat, "Data edit descriptor '%c' may not be used with an INTEGER data item", edit.descriptor); return false; } int digits = end - p; int leadingZeroes{0}; int editWidth{edit.width.value_or(0)}; if (edit.descriptor == 'I' && edit.digits && digits <= *edit.digits) { // Only Iw.m can produce leading zeroes, not Gw.d (F'202X 13.7.5.2.2) if (*edit.digits == 0 && n == 0) { // Iw.0 with zero value: output field must be blank. For I0.0 // and a zero value, emit one blank character. signChars = 0; // in case of SP editWidth = std::max(1, editWidth); } else { leadingZeroes = *edit.digits - digits; } } else if (n == 0) { leadingZeroes = 1; } int subTotal{signChars + leadingZeroes + digits}; int leadingSpaces{std::max(0, editWidth - subTotal)}; if (editWidth > 0 && leadingSpaces + subTotal > editWidth) { return EmitRepeated(io, '*', editWidth); } if (edit.IsListDirected()) { int total{std::max(leadingSpaces, 1) + subTotal}; if (io.GetConnectionState().NeedAdvance(static_cast(total)) && !io.AdvanceRecord()) { return false; } leadingSpaces = 1; } return EmitRepeated(io, ' ', leadingSpaces) && EmitAscii(io, n < 0 ? "-" : "+", signChars) && EmitRepeated(io, '0', leadingZeroes) && EmitAscii(io, p, digits); } // Formats the exponent (see table 13.1 for all the cases) RT_API_ATTRS const char *RealOutputEditingBase::FormatExponent( int expo, const DataEdit &edit, int &length) { char *eEnd{&exponent_[sizeof exponent_]}; char *exponent{eEnd}; for (unsigned e{static_cast(std::abs(expo))}; e > 0;) { unsigned quotient{e / 10u}; *--exponent = '0' + e - 10 * quotient; e = quotient; } bool overflow{false}; if (edit.expoDigits) { if (int ed{*edit.expoDigits}) { // Ew.dEe with e > 0 overflow = exponent + ed < eEnd; while (exponent > exponent_ + 2 /*E+*/ && exponent + ed > eEnd) { *--exponent = '0'; } } else if (exponent == eEnd) { *--exponent = '0'; // Ew.dE0 with zero-valued exponent } } else if (edit.variation == 'X') { if (expo == 0) { *--exponent = '0'; // EX without Ee and zero-valued exponent } } else { // Ensure at least two exponent digits unless EX while (exponent + 2 > eEnd) { *--exponent = '0'; } } *--exponent = expo < 0 ? '-' : '+'; if (edit.variation == 'X') { *--exponent = 'P'; } else if (edit.expoDigits || edit.IsListDirected() || exponent + 3 == eEnd) { *--exponent = edit.descriptor == 'D' ? 'D' : 'E'; // not 'G' or 'Q' } length = eEnd - exponent; return overflow ? nullptr : exponent; } RT_API_ATTRS bool RealOutputEditingBase::EmitPrefix( const DataEdit &edit, std::size_t length, std::size_t width) { if (edit.IsListDirected()) { int prefixLength{edit.descriptor == DataEdit::ListDirectedRealPart ? 2 : edit.descriptor == DataEdit::ListDirectedImaginaryPart ? 0 : 1}; int suffixLength{edit.descriptor == DataEdit::ListDirectedRealPart || edit.descriptor == DataEdit::ListDirectedImaginaryPart ? 1 : 0}; length += prefixLength + suffixLength; ConnectionState &connection{io_.GetConnectionState()}; return (!connection.NeedAdvance(length) || io_.AdvanceRecord()) && EmitAscii(io_, " (", prefixLength); } else if (width > length) { return EmitRepeated(io_, ' ', width - length); } else { return true; } } RT_API_ATTRS bool RealOutputEditingBase::EmitSuffix(const DataEdit &edit) { if (edit.descriptor == DataEdit::ListDirectedRealPart) { return EmitAscii( io_, edit.modes.editingFlags & decimalComma ? ";" : ",", 1); } else if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) { return EmitAscii(io_, ")", 1); } else { return true; } } template RT_API_ATTRS decimal::ConversionToDecimalResult RealOutputEditing::ConvertToDecimal( int significantDigits, enum decimal::FortranRounding rounding, int flags) { auto converted{decimal::ConvertToDecimal(buffer_, sizeof buffer_, static_cast(flags), significantDigits, rounding, x_)}; if (!converted.str) { // overflow io_.GetIoErrorHandler().Crash( "RealOutputEditing::ConvertToDecimal: buffer size %zd was insufficient", sizeof buffer_); } return converted; } static RT_API_ATTRS bool IsInfOrNaN(const char *p, int length) { if (!p || length < 1) { return false; } if (*p == '-' || *p == '+') { if (length == 1) { return false; } ++p; } return *p == 'I' || *p == 'N'; } // 13.7.2.3.3 in F'2018 template RT_API_ATTRS bool RealOutputEditing::EditEorDOutput( const DataEdit &edit) { addSpaceBeforeCharacter(io_); int editDigits{edit.digits.value_or(0)}; // 'd' field int editWidth{edit.width.value_or(0)}; // 'w' field int significantDigits{editDigits}; int flags{0}; if (edit.modes.editingFlags & signPlus) { flags |= decimal::AlwaysSign; } int scale{edit.modes.scale}; // 'kP' value bool isEN{edit.variation == 'N'}; bool isES{edit.variation == 'S'}; if (editWidth == 0) { // "the processor selects the field width" if (edit.digits.has_value()) { // E0.d if (editDigits == 0 && scale <= 0) { // E0.0 significantDigits = isEN || isES ? 0 : 1; } } else { // E0 flags |= decimal::Minimize; significantDigits = sizeof buffer_ - 5; // sign, NUL, + 3 extra for EN scaling } } int zeroesAfterPoint{0}; if (isEN) { scale = IsZero() ? 1 : 3; significantDigits += scale; } else if (isES) { scale = 1; ++significantDigits; } else if (scale < 0) { if (scale <= -editDigits) { io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor, "Scale factor (kP) %d cannot be less than -d (%d)", scale, -editDigits); return false; } zeroesAfterPoint = -scale; significantDigits = std::max(0, significantDigits - zeroesAfterPoint); } else if (scale > 0) { if (scale >= editDigits + 2) { io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor, "Scale factor (kP) %d cannot be greater than d+2 (%d)", scale, editDigits + 2); return false; } ++significantDigits; scale = std::min(scale, significantDigits + 1); } else if (edit.digits.value_or(1) == 0 && !edit.variation) { // F'2023 13.7.2.3.3 p5; does not apply to Gw.0(Ee) or E0(no d) io_.GetIoErrorHandler().SignalError(IostatErrorInFormat, "Output edit descriptor %cw.d must have d>0", edit.descriptor); return false; } // In EN editing, multiple attempts may be necessary, so this is a loop. while (true) { decimal::ConversionToDecimalResult converted{ ConvertToDecimal(significantDigits, edit.modes.round, flags)}; if (IsInfOrNaN(converted.str, static_cast(converted.length))) { return editWidth > 0 && converted.length + trailingBlanks_ > static_cast(editWidth) ? EmitRepeated(io_, '*', editWidth) : EmitPrefix(edit, converted.length, editWidth) && EmitAscii(io_, converted.str, converted.length) && EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit); } if (!IsZero()) { converted.decimalExponent -= scale; } if (isEN) { // EN mode: we need an effective exponent field that is // a multiple of three. if (int modulus{converted.decimalExponent % 3}; modulus != 0) { if (significantDigits > 1) { --significantDigits; --scale; continue; } // Rounded nines up to a 1. scale += modulus; converted.decimalExponent -= modulus; } if (scale > 3) { int adjust{3 * (scale / 3)}; scale -= adjust; converted.decimalExponent += adjust; } else if (scale < 1) { int adjust{3 - 3 * (scale / 3)}; scale += adjust; converted.decimalExponent -= adjust; } significantDigits = editDigits + scale; } // Format the exponent (see table 13.1 for all the cases) int expoLength{0}; const char *exponent{ FormatExponent(converted.decimalExponent, edit, expoLength)}; int signLength{*converted.str == '-' || *converted.str == '+' ? 1 : 0}; int convertedDigits{static_cast(converted.length) - signLength}; int zeroesBeforePoint{std::max(0, scale - convertedDigits)}; int digitsBeforePoint{std::max(0, scale - zeroesBeforePoint)}; int digitsAfterPoint{convertedDigits - digitsBeforePoint}; int trailingZeroes{flags & decimal::Minimize ? 0 : std::max(0, significantDigits - (convertedDigits + zeroesBeforePoint))}; int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint + 1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes + expoLength}; int width{editWidth > 0 ? editWidth : totalLength}; if (totalLength > width || !exponent) { return EmitRepeated(io_, '*', width); } if (totalLength < width && digitsBeforePoint == 0 && zeroesBeforePoint == 0) { zeroesBeforePoint = 1; ++totalLength; } if (totalLength < width && editWidth == 0) { width = totalLength; } return EmitPrefix(edit, totalLength, width) && EmitAscii(io_, converted.str, signLength + digitsBeforePoint) && EmitRepeated(io_, '0', zeroesBeforePoint) && EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) && EmitRepeated(io_, '0', zeroesAfterPoint) && EmitAscii(io_, converted.str + signLength + digitsBeforePoint, digitsAfterPoint) && EmitRepeated(io_, '0', trailingZeroes) && EmitAscii(io_, exponent, expoLength) && EmitSuffix(edit); } } // 13.7.2.3.2 in F'2018 template RT_API_ATTRS bool RealOutputEditing::EditFOutput(const DataEdit &edit) { addSpaceBeforeCharacter(io_); int fracDigits{edit.digits.value_or(0)}; // 'd' field const int editWidth{edit.width.value_or(0)}; // 'w' field enum decimal::FortranRounding rounding{edit.modes.round}; int flags{0}; if (edit.modes.editingFlags & signPlus) { flags |= decimal::AlwaysSign; } if (editWidth == 0) { // "the processor selects the field width" if (!edit.digits.has_value()) { // F0 flags |= decimal::Minimize; fracDigits = sizeof buffer_ - 2; // sign & NUL } } bool emitTrailingZeroes{!(flags & decimal::Minimize)}; // Multiple conversions may be needed to get the right number of // effective rounded fractional digits. bool canIncrease{true}; for (int extraDigits{fracDigits == 0 ? 1 : 0};;) { decimal::ConversionToDecimalResult converted{ ConvertToDecimal(extraDigits + fracDigits, rounding, flags)}; const char *convertedStr{converted.str}; if (IsInfOrNaN(convertedStr, static_cast(converted.length))) { return editWidth > 0 && converted.length > static_cast(editWidth) ? EmitRepeated(io_, '*', editWidth) : EmitPrefix(edit, converted.length, editWidth) && EmitAscii(io_, convertedStr, converted.length) && EmitSuffix(edit); } int expo{converted.decimalExponent + edit.modes.scale /*kP*/}; int signLength{*convertedStr == '-' || *convertedStr == '+' ? 1 : 0}; int convertedDigits{static_cast(converted.length) - signLength}; if (IsZero()) { // don't treat converted "0" as significant digit expo = 0; convertedDigits = 0; } bool isNegative{*convertedStr == '-'}; char one[2]; if (expo > extraDigits && extraDigits >= 0 && canIncrease) { extraDigits = expo; if (!edit.digits.has_value()) { // F0 fracDigits = sizeof buffer_ - extraDigits - 2; // sign & NUL } canIncrease = false; // only once continue; } else if (expo == -fracDigits && convertedDigits > 0) { // Result will be either a signed zero or power of ten, depending // on rounding. char leading{convertedStr[signLength]}; bool roundToPowerOfTen{false}; switch (edit.modes.round) { case decimal::FortranRounding::RoundUp: roundToPowerOfTen = !isNegative; break; case decimal::FortranRounding::RoundDown: roundToPowerOfTen = isNegative; break; case decimal::FortranRounding::RoundToZero: break; case decimal::FortranRounding::RoundNearest: if (leading == '5' && rounding == decimal::FortranRounding::RoundNearest) { // Try again, rounding away from zero. rounding = isNegative ? decimal::FortranRounding::RoundDown : decimal::FortranRounding::RoundUp; extraDigits = 1 - fracDigits; // just one digit needed continue; } roundToPowerOfTen = leading > '5'; break; case decimal::FortranRounding::RoundCompatible: roundToPowerOfTen = leading >= '5'; break; } if (roundToPowerOfTen) { ++expo; convertedDigits = 1; if (signLength > 0) { one[0] = *convertedStr; one[1] = '1'; } else { one[0] = '1'; } convertedStr = one; } else { expo = 0; convertedDigits = 0; } } else if (expo < extraDigits && extraDigits > -fracDigits) { extraDigits = std::max(expo, -fracDigits); continue; } int digitsBeforePoint{std::max(0, std::min(expo, convertedDigits))}; int zeroesBeforePoint{std::max(0, expo - digitsBeforePoint)}; if (zeroesBeforePoint > 0 && (flags & decimal::Minimize)) { // If a minimized result looks like an integer, emit all of // its digits rather than clipping some to zeroes. // This can happen with HUGE(0._2) == 65504._2. flags &= ~decimal::Minimize; continue; } int zeroesAfterPoint{std::min(fracDigits, std::max(0, -expo))}; int digitsAfterPoint{convertedDigits - digitsBeforePoint}; int trailingZeroes{emitTrailingZeroes ? std::max(0, fracDigits - (zeroesAfterPoint + digitsAfterPoint)) : 0}; if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint + digitsAfterPoint + trailingZeroes == 0) { zeroesBeforePoint = 1; // "." -> "0." } int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint + 1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes + trailingBlanks_ /* G editing converted to F */}; int width{editWidth > 0 || trailingBlanks_ ? editWidth : totalLength}; if (totalLength > width) { return EmitRepeated(io_, '*', width); } if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) { zeroesBeforePoint = 1; ++totalLength; } return EmitPrefix(edit, totalLength, width) && EmitAscii(io_, convertedStr, signLength + digitsBeforePoint) && EmitRepeated(io_, '0', zeroesBeforePoint) && EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) && EmitRepeated(io_, '0', zeroesAfterPoint) && EmitAscii(io_, convertedStr + signLength + digitsBeforePoint, digitsAfterPoint) && EmitRepeated(io_, '0', trailingZeroes) && EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit); } } // 13.7.5.2.3 in F'2018 template RT_API_ATTRS DataEdit RealOutputEditing::EditForGOutput(DataEdit edit) { edit.descriptor = 'E'; edit.variation = 'G'; // to suppress error for Ew.0 int editWidth{edit.width.value_or(0)}; int significantDigits{edit.digits.value_or( static_cast(BinaryFloatingPoint::decimalPrecision))}; // 'd' if (editWidth > 0 && significantDigits == 0) { return edit; // Gw.0Ee -> Ew.0Ee for w > 0 } int flags{0}; if (edit.modes.editingFlags & signPlus) { flags |= decimal::AlwaysSign; } decimal::ConversionToDecimalResult converted{ ConvertToDecimal(significantDigits, edit.modes.round, flags)}; if (IsInfOrNaN(converted.str, static_cast(converted.length))) { return edit; // Inf/Nan -> Ew.d (same as Fw.d) } int expo{IsZero() ? 1 : converted.decimalExponent}; // 's' if (expo < 0 || expo > significantDigits) { if (editWidth == 0 && !edit.expoDigits) { // G0.d -> G0.dE0 edit.expoDigits = 0; } return edit; // Ew.dEe } edit.descriptor = 'F'; edit.modes.scale = 0; // kP is ignored for G when no exponent field trailingBlanks_ = 0; if (editWidth > 0) { int expoDigits{edit.expoDigits.value_or(0)}; // F'2023 13.7.5.2.3 p5: "If 0 <= s <= d, the scale factor has no effect // and F(w − n).(d − s),n(’b’) editing is used where b is a blank and // n is 4 for Gw.d editing, e + 2 for Gw.dEe editing if e > 0, and // 4 for Gw.dE0 editing." trailingBlanks_ = expoDigits > 0 ? expoDigits + 2 : 4; // 'n' } if (edit.digits.has_value()) { *edit.digits = std::max(0, *edit.digits - expo); } return edit; } // 13.10.4 in F'2018 template RT_API_ATTRS bool RealOutputEditing::EditListDirectedOutput( const DataEdit &edit) { decimal::ConversionToDecimalResult converted{ ConvertToDecimal(1, edit.modes.round)}; if (IsInfOrNaN(converted.str, static_cast(converted.length))) { DataEdit copy{edit}; copy.variation = DataEdit::ListDirected; return EditEorDOutput(copy); } int expo{converted.decimalExponent}; // The decimal precision of 16-bit floating-point types is very low, // so use a reasonable cap of 6 to allow more values to be emitted // with Fw.d editing. static constexpr int maxExpo{ std::max(6, BinaryFloatingPoint::decimalPrecision)}; if (expo < 0 || expo > maxExpo) { DataEdit copy{edit}; copy.variation = DataEdit::ListDirected; copy.modes.scale = 1; // 1P return EditEorDOutput(copy); } else { return EditFOutput(edit); } } // 13.7.2.3.6 in F'2023 // The specification for hexadecimal output, unfortunately for implementors, // leaves as "implementation dependent" the choice of how to emit values // with multiple hexadecimal output possibilities that are numerically // equivalent. The one working implementation of EX output that I can find // apparently chooses to frame the nybbles from most to least significant, // rather than trying to minimize the magnitude of the binary exponent. // E.g., 2. is edited into 0X8.0P-2 rather than 0X2.0P0. This implementation // follows that precedent so as to avoid a gratuitous incompatibility. template RT_API_ATTRS auto RealOutputEditing::ConvertToHexadecimal( int significantDigits, enum decimal::FortranRounding rounding, int flags) -> ConvertToHexadecimalResult { if (x_.IsNaN() || x_.IsInfinite()) { auto converted{ConvertToDecimal(significantDigits, rounding, flags)}; return {converted.str, static_cast(converted.length), 0}; } x_.RoundToBits(4 * significantDigits, rounding); if (x_.IsInfinite()) { // rounded away to +/-Inf auto converted{ConvertToDecimal(significantDigits, rounding, flags)}; return {converted.str, static_cast(converted.length), 0}; } int len{0}; if (x_.IsNegative()) { buffer_[len++] = '-'; } else if (flags & decimal::AlwaysSign) { buffer_[len++] = '+'; } auto fraction{x_.Fraction()}; if (fraction == 0) { buffer_[len++] = '0'; return {buffer_, len, 0}; } else { // Ensure that the MSB is set. int expo{x_.UnbiasedExponent() - 3}; while (!(fraction >> (x_.binaryPrecision - 1))) { fraction <<= 1; --expo; } // This is initially the right shift count needed to bring the // most-significant hexadecimal digit's bits into the LSBs. // x_.binaryPrecision is constant, so / can be used for readability. int shift{x_.binaryPrecision - 4}; typename BinaryFloatingPoint::RawType one{1}; auto remaining{(one << x_.binaryPrecision) - one}; for (int digits{0}; digits < significantDigits; ++digits) { if ((flags & decimal::Minimize) && !(fraction & remaining)) { break; } int hexDigit{0}; if (shift >= 0) { hexDigit = int(fraction >> shift) & 0xf; } else if (shift >= -3) { hexDigit = int(fraction << -shift) & 0xf; } if (hexDigit >= 10) { buffer_[len++] = 'A' + hexDigit - 10; } else { buffer_[len++] = '0' + hexDigit; } shift -= 4; remaining >>= 4; } return {buffer_, len, expo}; } } template RT_API_ATTRS bool RealOutputEditing::EditEXOutput(const DataEdit &edit) { addSpaceBeforeCharacter(io_); int editDigits{edit.digits.value_or(0)}; // 'd' field int significantDigits{editDigits + 1}; int flags{0}; if (edit.modes.editingFlags & signPlus) { flags |= decimal::AlwaysSign; } int editWidth{edit.width.value_or(0)}; // 'w' field if ((editWidth == 0 && !edit.digits) || editDigits == 0) { // EX0 or EXw.0 flags |= decimal::Minimize; static constexpr int maxSigHexDigits{ (common::PrecisionOfRealKind(16) + 3) / 4}; significantDigits = maxSigHexDigits; } auto converted{ ConvertToHexadecimal(significantDigits, edit.modes.round, flags)}; if (IsInfOrNaN(converted.str, converted.length)) { return editWidth > 0 && converted.length > editWidth ? EmitRepeated(io_, '*', editWidth) : (editWidth <= converted.length || EmitRepeated(io_, ' ', editWidth - converted.length)) && EmitAscii(io_, converted.str, converted.length); } int signLength{converted.length > 0 && (converted.str[0] == '-' || converted.str[0] == '+') ? 1 : 0}; int convertedDigits{converted.length - signLength}; int expoLength{0}; const char *exponent{FormatExponent(converted.exponent, edit, expoLength)}; int trailingZeroes{flags & decimal::Minimize ? 0 : std::max(0, significantDigits - convertedDigits)}; int totalLength{converted.length + trailingZeroes + expoLength + 3 /*0X.*/}; int width{editWidth > 0 ? editWidth : totalLength}; return totalLength > width || !exponent ? EmitRepeated(io_, '*', width) : EmitRepeated(io_, ' ', width - totalLength) && EmitAscii(io_, converted.str, signLength) && EmitAscii(io_, "0X", 2) && EmitAscii(io_, converted.str + signLength, 1) && EmitAscii( io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) && EmitAscii(io_, converted.str + signLength + 1, converted.length - (signLength + 1)) && EmitRepeated(io_, '0', trailingZeroes) && EmitAscii(io_, exponent, expoLength); } template RT_API_ATTRS bool RealOutputEditing::Edit(const DataEdit &edit) { const DataEdit *editPtr{&edit}; DataEdit newEdit; if (editPtr->descriptor == 'G') { // Avoid recursive call as in Edit(EditForGOutput(edit)). newEdit = EditForGOutput(*editPtr); editPtr = &newEdit; RUNTIME_CHECK(io_.GetIoErrorHandler(), editPtr->descriptor != 'G'); } switch (editPtr->descriptor) { case 'D': return EditEorDOutput(*editPtr); case 'E': if (editPtr->variation == 'X') { return EditEXOutput(*editPtr); } else { return EditEorDOutput(*editPtr); } case 'F': return EditFOutput(*editPtr); case 'B': return EditBOZOutput<1>(io_, *editPtr, reinterpret_cast(&x_), common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3); case 'O': return EditBOZOutput<3>(io_, *editPtr, reinterpret_cast(&x_), common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3); case 'Z': return EditBOZOutput<4>(io_, *editPtr, reinterpret_cast(&x_), common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3); case 'L': return EditLogicalOutput( io_, *editPtr, *reinterpret_cast(&x_)); case 'A': // legacy extension return EditCharacterOutput( io_, *editPtr, reinterpret_cast(&x_), sizeof x_); default: if (editPtr->IsListDirected()) { return EditListDirectedOutput(*editPtr); } io_.GetIoErrorHandler().SignalError(IostatErrorInFormat, "Data edit descriptor '%c' may not be used with a REAL data item", editPtr->descriptor); return false; } return false; } RT_API_ATTRS bool ListDirectedLogicalOutput(IoStatementState &io, ListDirectedStatementState &list, bool truth) { return list.EmitLeadingSpaceOrAdvance(io) && EmitAscii(io, truth ? "T" : "F", 1); } RT_API_ATTRS bool EditLogicalOutput( IoStatementState &io, const DataEdit &edit, bool truth) { switch (edit.descriptor) { case 'L': case 'G': return EmitRepeated(io, ' ', std::max(0, edit.width.value_or(1) - 1)) && EmitAscii(io, truth ? "T" : "F", 1); case 'B': return EditBOZOutput<1>(io, edit, reinterpret_cast(&truth), sizeof truth); case 'O': return EditBOZOutput<3>(io, edit, reinterpret_cast(&truth), sizeof truth); case 'Z': return EditBOZOutput<4>(io, edit, reinterpret_cast(&truth), sizeof truth); case 'A': { // legacy extension int truthBits{truth}; int len{sizeof truthBits}; int width{edit.width.value_or(len)}; return EmitRepeated(io, ' ', std::max(0, width - len)) && EmitEncoded( io, reinterpret_cast(&truthBits), std::min(width, len)); } default: io.GetIoErrorHandler().SignalError(IostatErrorInFormat, "Data edit descriptor '%c' may not be used with a LOGICAL data item", edit.descriptor); return false; } } template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &io, ListDirectedStatementState &list, const CHAR *x, std::size_t length) { bool ok{true}; MutableModes &modes{io.mutableModes()}; ConnectionState &connection{io.GetConnectionState()}; if (modes.delim) { ok = ok && list.EmitLeadingSpaceOrAdvance(io); // Value is delimited with ' or " marks, and interior // instances of that character are doubled. auto EmitOne{[&](CHAR ch) { if (connection.NeedAdvance(1)) { ok = ok && io.AdvanceRecord(); } ok = ok && EmitEncoded(io, &ch, 1); }}; EmitOne(modes.delim); for (std::size_t j{0}; j < length; ++j) { // Doubled delimiters must be put on the same record // in order to be acceptable as list-directed or NAMELIST // input; however, this requirement is not always possible // when the records have a fixed length, as is the case with // internal output. The standard is silent on what should // happen, and no two extant Fortran implementations do // the same thing when tested with this case. // This runtime splits the doubled delimiters across // two records for lack of a better alternative. if (x[j] == static_cast(modes.delim)) { EmitOne(x[j]); } EmitOne(x[j]); } EmitOne(modes.delim); } else { // Undelimited list-directed output ok = ok && list.EmitLeadingSpaceOrAdvance(io, length > 0 ? 1 : 0, true); std::size_t put{0}; std::size_t oneAtATime{ connection.useUTF8() || connection.internalIoCharKind > 1 ? 1 : length}; while (ok && put < length) { if (std::size_t chunk{std::min( std::min(length - put, oneAtATime), connection.RemainingSpaceInRecord())}) { ok = EmitEncoded(io, x + put, chunk); put += chunk; } else { ok = io.AdvanceRecord() && EmitAscii(io, " ", 1); } } list.set_lastWasUndelimitedCharacter(true); } return ok; } template RT_API_ATTRS bool EditCharacterOutput(IoStatementState &io, const DataEdit &edit, const CHAR *x, std::size_t length) { int len{static_cast(length)}; int width{edit.width.value_or(len)}; switch (edit.descriptor) { case 'A': break; case 'G': if (width == 0) { width = len; } break; case 'B': return EditBOZOutput<1>(io, edit, reinterpret_cast(x), sizeof(CHAR) * length); case 'O': return EditBOZOutput<3>(io, edit, reinterpret_cast(x), sizeof(CHAR) * length); case 'Z': return EditBOZOutput<4>(io, edit, reinterpret_cast(x), sizeof(CHAR) * length); case 'L': return EditLogicalOutput(io, edit, *reinterpret_cast(x)); default: io.GetIoErrorHandler().SignalError(IostatErrorInFormat, "Data edit descriptor '%c' may not be used with a CHARACTER data item", edit.descriptor); return false; } return EmitRepeated(io, ' ', std::max(0, width - len)) && EmitEncoded(io, x, std::min(width, len)); } template RT_API_ATTRS bool EditIntegerOutput<1>( IoStatementState &, const DataEdit &, std::int8_t, bool); template RT_API_ATTRS bool EditIntegerOutput<2>( IoStatementState &, const DataEdit &, std::int16_t, bool); template RT_API_ATTRS bool EditIntegerOutput<4>( IoStatementState &, const DataEdit &, std::int32_t, bool); template RT_API_ATTRS bool EditIntegerOutput<8>( IoStatementState &, const DataEdit &, std::int64_t, bool); template RT_API_ATTRS bool EditIntegerOutput<16>( IoStatementState &, const DataEdit &, common::int128_t, bool); template class RealOutputEditing<2>; template class RealOutputEditing<3>; template class RealOutputEditing<4>; template class RealOutputEditing<8>; template class RealOutputEditing<10>; // TODO: double/double template class RealOutputEditing<16>; template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &, ListDirectedStatementState &, const char *, std::size_t chars); template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &, ListDirectedStatementState &, const char16_t *, std::size_t chars); template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &, ListDirectedStatementState &, const char32_t *, std::size_t chars); template RT_API_ATTRS bool EditCharacterOutput( IoStatementState &, const DataEdit &, const char *, std::size_t chars); template RT_API_ATTRS bool EditCharacterOutput( IoStatementState &, const DataEdit &, const char16_t *, std::size_t chars); template RT_API_ATTRS bool EditCharacterOutput( IoStatementState &, const DataEdit &, const char32_t *, std::size_t chars); RT_OFFLOAD_API_GROUP_END } // namespace Fortran::runtime::io