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