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