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

source code of flang/runtime/edit-output.cpp