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
16namespace Fortran::runtime::io {
17RT_OFFLOAD_API_GROUP_BEGIN
18
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/hexadecimal
27// 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 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(a: 1, b: 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(a: 0, b: 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
110template <int KIND>
111bool RT_API_ATTRS EditIntegerOutput(IoStatementState &io, const DataEdit &edit,
112 common::HostSignedIntType<8 * KIND> n) {
113 addSpaceBeforeCharacter(io);
114 char buffer[130], *end{&buffer[sizeof buffer]}, *p{end};
115 bool isNegative{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(a: 1, b: 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(a: 0, b: editWidth - subTotal)};
174 if (editWidth > 0 && leadingSpaces + subTotal > editWidth) {
175 return EmitRepeated(io, '*', editWidth);
176 }
177 if (edit.IsListDirected()) {
178 int total{std::max(a: leadingSpaces, b: 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)
191RT_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(x: 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
230RT_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
251RT_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
262template <int KIND>
263RT_API_ATTRS decimal::ConversionToDecimalResult
264RealOutputEditing<KIND>::ConvertToDecimal(
265 int significantDigits, enum decimal::FortranRounding rounding, int flags) {
266#if !defined(RT_DEVICE_COMPILATION)
267 auto converted{decimal::ConvertToDecimal<binaryPrecision>(buffer_,
268 sizeof buffer_, static_cast<enum decimal::DecimalConversionFlags>(flags),
269 significantDigits, rounding, x_)};
270 if (!converted.str) { // overflow
271 io_.GetIoErrorHandler().Crash(
272 "RealOutputEditing::ConvertToDecimal: buffer size %zd was insufficient",
273 sizeof buffer_);
274 }
275 return converted;
276#else // defined(RT_DEVICE_COMPILATION)
277 // TODO: enable Decimal library build for the device.
278 io_.GetIoErrorHandler().Crash("not implemented yet: decimal conversion");
279#endif // defined(RT_DEVICE_COMPILATION)
280}
281
282static RT_API_ATTRS bool IsInfOrNaN(const char *p, int length) {
283 if (!p || length < 1) {
284 return false;
285 }
286 if (*p == '-' || *p == '+') {
287 if (length == 1) {
288 return false;
289 }
290 ++p;
291 }
292 return *p == 'I' || *p == 'N';
293}
294
295// 13.7.2.3.3 in F'2018
296template <int KIND>
297RT_API_ATTRS bool RealOutputEditing<KIND>::EditEorDOutput(
298 const DataEdit &edit) {
299 addSpaceBeforeCharacter(io_);
300 int editDigits{edit.digits.value_or(0)}; // 'd' field
301 int editWidth{edit.width.value_or(0)}; // 'w' field
302 int significantDigits{editDigits};
303 int flags{0};
304 if (edit.modes.editingFlags & signPlus) {
305 flags |= decimal::AlwaysSign;
306 }
307 int scale{edit.modes.scale}; // 'kP' value
308 if (editWidth == 0) { // "the processor selects the field width"
309 if (edit.digits.has_value()) { // E0.d
310 if (editDigits == 0 && scale <= 0) { // E0.0
311 significantDigits = 1;
312 }
313 } else { // E0
314 flags |= decimal::Minimize;
315 significantDigits =
316 sizeof buffer_ - 5; // sign, NUL, + 3 extra for EN scaling
317 }
318 }
319 bool isEN{edit.variation == 'N'};
320 bool isES{edit.variation == 'S'};
321 int zeroesAfterPoint{0};
322 if (isEN) {
323 scale = IsZero() ? 1 : 3;
324 significantDigits += scale;
325 } else if (isES) {
326 scale = 1;
327 ++significantDigits;
328 } else if (scale < 0) {
329 if (scale <= -editDigits) {
330 io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor,
331 "Scale factor (kP) %d cannot be less than -d (%d)", scale,
332 -editDigits);
333 return false;
334 }
335 zeroesAfterPoint = -scale;
336 significantDigits = std::max(a: 0, b: significantDigits - zeroesAfterPoint);
337 } else if (scale > 0) {
338 if (scale >= editDigits + 2) {
339 io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor,
340 "Scale factor (kP) %d cannot be greater than d+2 (%d)", scale,
341 editDigits + 2);
342 return false;
343 }
344 ++significantDigits;
345 scale = std::min(a: scale, b: significantDigits + 1);
346 } else if (edit.digits.value_or(1) == 0 && !edit.variation) {
347 // F'2023 13.7.2.3.3 p5; does not apply to Gw.0(Ee) or E0(no d)
348 io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
349 "Output edit descriptor %cw.d must have d>0", edit.descriptor);
350 return false;
351 }
352 // In EN editing, multiple attempts may be necessary, so this is a loop.
353 while (true) {
354 decimal::ConversionToDecimalResult converted{
355 ConvertToDecimal(significantDigits, edit.modes.round, flags)};
356 if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
357 return editWidth > 0 &&
358 converted.length + trailingBlanks_ >
359 static_cast<std::size_t>(editWidth)
360 ? EmitRepeated(io_, '*', editWidth)
361 : EmitPrefix(edit, converted.length, editWidth) &&
362 EmitAscii(io_, converted.str, converted.length) &&
363 EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit);
364 }
365 if (!IsZero()) {
366 converted.decimalExponent -= scale;
367 }
368 if (isEN) {
369 // EN mode: we need an effective exponent field that is
370 // a multiple of three.
371 if (int modulus{converted.decimalExponent % 3}; modulus != 0) {
372 if (significantDigits > 1) {
373 --significantDigits;
374 --scale;
375 continue;
376 }
377 // Rounded nines up to a 1.
378 scale += modulus;
379 converted.decimalExponent -= modulus;
380 }
381 if (scale > 3) {
382 int adjust{3 * (scale / 3)};
383 scale -= adjust;
384 converted.decimalExponent += adjust;
385 } else if (scale < 1) {
386 int adjust{3 - 3 * (scale / 3)};
387 scale += adjust;
388 converted.decimalExponent -= adjust;
389 }
390 significantDigits = editDigits + scale;
391 }
392 // Format the exponent (see table 13.1 for all the cases)
393 int expoLength{0};
394 const char *exponent{
395 FormatExponent(converted.decimalExponent, edit, expoLength)};
396 int signLength{*converted.str == '-' || *converted.str == '+' ? 1 : 0};
397 int convertedDigits{static_cast<int>(converted.length) - signLength};
398 int zeroesBeforePoint{std::max(a: 0, b: scale - convertedDigits)};
399 int digitsBeforePoint{std::max(a: 0, b: scale - zeroesBeforePoint)};
400 int digitsAfterPoint{convertedDigits - digitsBeforePoint};
401 int trailingZeroes{flags & decimal::Minimize
402 ? 0
403 : std::max(0,
404 significantDigits - (convertedDigits + zeroesBeforePoint))};
405 int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
406 1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
407 expoLength};
408 int width{editWidth > 0 ? editWidth : totalLength};
409 if (totalLength > width || !exponent) {
410 return EmitRepeated(io_, '*', width);
411 }
412 if (totalLength < width && digitsBeforePoint == 0 &&
413 zeroesBeforePoint == 0) {
414 zeroesBeforePoint = 1;
415 ++totalLength;
416 }
417 if (totalLength < width && editWidth == 0) {
418 width = totalLength;
419 }
420 return EmitPrefix(edit, totalLength, width) &&
421 EmitAscii(io_, converted.str, signLength + digitsBeforePoint) &&
422 EmitRepeated(io_, '0', zeroesBeforePoint) &&
423 EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
424 EmitRepeated(io_, '0', zeroesAfterPoint) &&
425 EmitAscii(io_, converted.str + signLength + digitsBeforePoint,
426 digitsAfterPoint) &&
427 EmitRepeated(io_, '0', trailingZeroes) &&
428 EmitAscii(io_, exponent, expoLength) && EmitSuffix(edit);
429 }
430}
431
432// 13.7.2.3.2 in F'2018
433template <int KIND>
434RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
435 addSpaceBeforeCharacter(io_);
436 int fracDigits{edit.digits.value_or(0)}; // 'd' field
437 const int editWidth{edit.width.value_or(0)}; // 'w' field
438 enum decimal::FortranRounding rounding{edit.modes.round};
439 int flags{0};
440 if (edit.modes.editingFlags & signPlus) {
441 flags |= decimal::AlwaysSign;
442 }
443 if (editWidth == 0) { // "the processor selects the field width"
444 if (!edit.digits.has_value()) { // F0
445 flags |= decimal::Minimize;
446 fracDigits = sizeof buffer_ - 2; // sign & NUL
447 }
448 }
449 // Multiple conversions may be needed to get the right number of
450 // effective rounded fractional digits.
451 bool canIncrease{true};
452 for (int extraDigits{fracDigits == 0 ? 1 : 0};;) {
453 decimal::ConversionToDecimalResult converted{
454 ConvertToDecimal(extraDigits + fracDigits, rounding, flags)};
455 const char *convertedStr{converted.str};
456 if (IsInfOrNaN(p: convertedStr, length: static_cast<int>(converted.length))) {
457 return editWidth > 0 &&
458 converted.length > static_cast<std::size_t>(editWidth)
459 ? EmitRepeated(io_, '*', editWidth)
460 : EmitPrefix(edit, converted.length, editWidth) &&
461 EmitAscii(io_, convertedStr, converted.length) &&
462 EmitSuffix(edit);
463 }
464 int expo{converted.decimalExponent + edit.modes.scale /*kP*/};
465 int signLength{*convertedStr == '-' || *convertedStr == '+' ? 1 : 0};
466 int convertedDigits{static_cast<int>(converted.length) - signLength};
467 if (IsZero()) { // don't treat converted "0" as significant digit
468 expo = 0;
469 convertedDigits = 0;
470 }
471 bool isNegative{*convertedStr == '-'};
472 char one[2];
473 if (expo > extraDigits && extraDigits >= 0 && canIncrease) {
474 extraDigits = expo;
475 if (!edit.digits.has_value()) { // F0
476 fracDigits = sizeof buffer_ - extraDigits - 2; // sign & NUL
477 }
478 canIncrease = false; // only once
479 continue;
480 } else if (expo == -fracDigits && convertedDigits > 0) {
481 // Result will be either a signed zero or power of ten, depending
482 // on rounding.
483 char leading{convertedStr[signLength]};
484 bool roundToPowerOfTen{false};
485 switch (edit.modes.round) {
486 case decimal::FortranRounding::RoundUp:
487 roundToPowerOfTen = !isNegative;
488 break;
489 case decimal::FortranRounding::RoundDown:
490 roundToPowerOfTen = isNegative;
491 break;
492 case decimal::FortranRounding::RoundToZero:
493 break;
494 case decimal::FortranRounding::RoundNearest:
495 if (leading == '5' &&
496 rounding == decimal::FortranRounding::RoundNearest) {
497 // Try again, rounding away from zero.
498 rounding = isNegative ? decimal::FortranRounding::RoundDown
499 : decimal::FortranRounding::RoundUp;
500 extraDigits = 1 - fracDigits; // just one digit needed
501 continue;
502 }
503 roundToPowerOfTen = leading > '5';
504 break;
505 case decimal::FortranRounding::RoundCompatible:
506 roundToPowerOfTen = leading >= '5';
507 break;
508 }
509 if (roundToPowerOfTen) {
510 ++expo;
511 convertedDigits = 1;
512 if (signLength > 0) {
513 one[0] = *convertedStr;
514 one[1] = '1';
515 } else {
516 one[0] = '1';
517 }
518 convertedStr = one;
519 } else {
520 expo = 0;
521 convertedDigits = 0;
522 }
523 } else if (expo < extraDigits && extraDigits > -fracDigits) {
524 extraDigits = std::max(a: expo, b: -fracDigits);
525 continue;
526 }
527 int digitsBeforePoint{std::max(a: 0, b: std::min(a: expo, b: convertedDigits))};
528 int zeroesBeforePoint{std::max(a: 0, b: expo - digitsBeforePoint)};
529 int zeroesAfterPoint{std::min(a: fracDigits, b: std::max(a: 0, b: -expo))};
530 int digitsAfterPoint{convertedDigits - digitsBeforePoint};
531 int trailingZeroes{flags & decimal::Minimize
532 ? 0
533 : std::max(0, fracDigits - (zeroesAfterPoint + digitsAfterPoint))};
534 if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint +
535 digitsAfterPoint + trailingZeroes ==
536 0) {
537 zeroesBeforePoint = 1; // "." -> "0."
538 }
539 int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
540 1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
541 trailingBlanks_ /* G editing converted to F */};
542 int width{editWidth > 0 || trailingBlanks_ ? editWidth : totalLength};
543 if (totalLength > width) {
544 return EmitRepeated(io_, '*', width);
545 }
546 if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
547 zeroesBeforePoint = 1;
548 ++totalLength;
549 }
550 return EmitPrefix(edit, totalLength, width) &&
551 EmitAscii(io_, convertedStr, signLength + digitsBeforePoint) &&
552 EmitRepeated(io_, '0', zeroesBeforePoint) &&
553 EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
554 EmitRepeated(io_, '0', zeroesAfterPoint) &&
555 EmitAscii(io_, convertedStr + signLength + digitsBeforePoint,
556 digitsAfterPoint) &&
557 EmitRepeated(io_, '0', trailingZeroes) &&
558 EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit);
559 }
560}
561
562// 13.7.5.2.3 in F'2018
563template <int KIND>
564RT_API_ATTRS DataEdit RealOutputEditing<KIND>::EditForGOutput(DataEdit edit) {
565 edit.descriptor = 'E';
566 edit.variation = 'G'; // to suppress error for Ew.0
567 int editWidth{edit.width.value_or(0)};
568 int significantDigits{edit.digits.value_or(
569 static_cast<int>(BinaryFloatingPoint::decimalPrecision))}; // 'd'
570 if (editWidth > 0 && significantDigits == 0) {
571 return edit; // Gw.0Ee -> Ew.0Ee for w > 0
572 }
573 int flags{0};
574 if (edit.modes.editingFlags & signPlus) {
575 flags |= decimal::AlwaysSign;
576 }
577 decimal::ConversionToDecimalResult converted{
578 ConvertToDecimal(significantDigits, edit.modes.round, flags)};
579 if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
580 return edit; // Inf/Nan -> Ew.d (same as Fw.d)
581 }
582 int expo{IsZero() ? 1 : converted.decimalExponent}; // 's'
583 if (expo < 0 || expo > significantDigits) {
584 if (editWidth == 0 && !edit.expoDigits) { // G0.d -> G0.dE0
585 edit.expoDigits = 0;
586 }
587 return edit; // Ew.dEe
588 }
589 edit.descriptor = 'F';
590 edit.modes.scale = 0; // kP is ignored for G when no exponent field
591 trailingBlanks_ = 0;
592 if (editWidth > 0) {
593 int expoDigits{edit.expoDigits.value_or(0)};
594 // F'2023 13.7.5.2.3 p5: "If 0 <= s <= d, the scale factor has no effect
595 // and F(w − n).(d − s),n(’b’) editing is used where b is a blank and
596 // n is 4 for Gw.d editing, e + 2 for Gw.dEe editing if e > 0, and
597 // 4 for Gw.dE0 editing."
598 trailingBlanks_ = expoDigits > 0 ? expoDigits + 2 : 4; // 'n'
599 }
600 if (edit.digits.has_value()) {
601 *edit.digits = std::max(0, *edit.digits - expo);
602 }
603 return edit;
604}
605
606// 13.10.4 in F'2018
607template <int KIND>
608RT_API_ATTRS bool RealOutputEditing<KIND>::EditListDirectedOutput(
609 const DataEdit &edit) {
610 decimal::ConversionToDecimalResult converted{
611 ConvertToDecimal(1, edit.modes.round)};
612 if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
613 DataEdit copy{edit};
614 copy.variation = DataEdit::ListDirected;
615 return EditEorDOutput(copy);
616 }
617 int expo{converted.decimalExponent};
618 // The decimal precision of 16-bit floating-point types is very low,
619 // so use a reasonable cap of 6 to allow more values to be emitted
620 // with Fw.d editing.
621 static constexpr int maxExpo{
622 std::max(6, BinaryFloatingPoint::decimalPrecision)};
623 if (expo < 0 || expo > maxExpo) {
624 DataEdit copy{edit};
625 copy.variation = DataEdit::ListDirected;
626 copy.modes.scale = 1; // 1P
627 return EditEorDOutput(copy);
628 } else {
629 return EditFOutput(edit);
630 }
631}
632
633// 13.7.2.3.6 in F'2023
634// The specification for hexadecimal output, unfortunately for implementors,
635// leaves as "implementation dependent" the choice of how to emit values
636// with multiple hexadecimal output possibilities that are numerically
637// equivalent. The one working implementation of EX output that I can find
638// apparently chooses to frame the nybbles from most to least significant,
639// rather than trying to minimize the magnitude of the binary exponent.
640// E.g., 2. is edited into 0X8.0P-2 rather than 0X2.0P0. This implementation
641// follows that precedent so as to avoid a gratuitous incompatibility.
642template <int KIND>
643RT_API_ATTRS auto RealOutputEditing<KIND>::ConvertToHexadecimal(
644 int significantDigits, enum decimal::FortranRounding rounding,
645 int flags) -> ConvertToHexadecimalResult {
646 if (x_.IsNaN() || x_.IsInfinite()) {
647 auto converted{ConvertToDecimal(significantDigits, rounding, flags)};
648 return {converted.str, static_cast<int>(converted.length), 0};
649 }
650 x_.RoundToBits(4 * significantDigits, rounding);
651 if (x_.IsInfinite()) { // rounded away to +/-Inf
652 auto converted{ConvertToDecimal(significantDigits, rounding, flags)};
653 return {converted.str, static_cast<int>(converted.length), 0};
654 }
655 int len{0};
656 if (x_.IsNegative()) {
657 buffer_[len++] = '-';
658 } else if (flags & decimal::AlwaysSign) {
659 buffer_[len++] = '+';
660 }
661 auto fraction{x_.Fraction()};
662 if (fraction == 0) {
663 buffer_[len++] = '0';
664 return {buffer_, len, 0};
665 } else {
666 // Ensure that the MSB is set.
667 int expo{x_.UnbiasedExponent() - 3};
668 while (!(fraction >> (x_.binaryPrecision - 1))) {
669 fraction <<= 1;
670 --expo;
671 }
672 // This is initially the right shift count needed to bring the
673 // most-significant hexadecimal digit's bits into the LSBs.
674 // x_.binaryPrecision is constant, so / can be used for readability.
675 int shift{x_.binaryPrecision - 4};
676 typename BinaryFloatingPoint::RawType one{1};
677 auto remaining{(one << x_.binaryPrecision) - one};
678 for (int digits{0}; digits < significantDigits; ++digits) {
679 if ((flags & decimal::Minimize) && !(fraction & remaining)) {
680 break;
681 }
682 int hexDigit{0};
683 if (shift >= 0) {
684 hexDigit = int(fraction >> shift) & 0xf;
685 } else if (shift >= -3) {
686 hexDigit = int(fraction << -shift) & 0xf;
687 }
688 if (hexDigit >= 10) {
689 buffer_[len++] = 'A' + hexDigit - 10;
690 } else {
691 buffer_[len++] = '0' + hexDigit;
692 }
693 shift -= 4;
694 remaining >>= 4;
695 }
696 return {buffer_, len, expo};
697 }
698}
699
700template <int KIND>
701RT_API_ATTRS bool RealOutputEditing<KIND>::EditEXOutput(const DataEdit &edit) {
702 addSpaceBeforeCharacter(io_);
703 int editDigits{edit.digits.value_or(0)}; // 'd' field
704 int significantDigits{editDigits + 1};
705 int flags{0};
706 if (edit.modes.editingFlags & signPlus) {
707 flags |= decimal::AlwaysSign;
708 }
709 int editWidth{edit.width.value_or(0)}; // 'w' field
710 if ((editWidth == 0 && !edit.digits) || editDigits == 0) {
711 // EX0 or EXw.0
712 flags |= decimal::Minimize;
713 static constexpr int maxSigHexDigits{
714 (common::PrecisionOfRealKind(16) + 3) / 4};
715 significantDigits = maxSigHexDigits;
716 }
717 auto converted{
718 ConvertToHexadecimal(significantDigits, edit.modes.round, flags)};
719 if (IsInfOrNaN(converted.str, converted.length)) {
720 return editWidth > 0 && converted.length > editWidth
721 ? EmitRepeated(io_, '*', editWidth)
722 : (editWidth <= converted.length ||
723 EmitRepeated(io_, ' ', editWidth - converted.length)) &&
724 EmitAscii(io_, converted.str, converted.length);
725 }
726 int signLength{converted.length > 0 &&
727 (converted.str[0] == '-' || converted.str[0] == '+')
728 ? 1
729 : 0};
730 int convertedDigits{converted.length - signLength};
731 int expoLength{0};
732 const char *exponent{FormatExponent(converted.exponent, edit, expoLength)};
733 int trailingZeroes{flags & decimal::Minimize
734 ? 0
735 : std::max(0, significantDigits - convertedDigits)};
736 int totalLength{converted.length + trailingZeroes + expoLength + 3 /*0X.*/};
737 int width{editWidth > 0 ? editWidth : totalLength};
738 return totalLength > width || !exponent
739 ? EmitRepeated(io_, '*', width)
740 : EmitRepeated(io_, ' ', width - totalLength) &&
741 EmitAscii(io_, converted.str, signLength) &&
742 EmitAscii(io_, "0X", 2) &&
743 EmitAscii(io_, converted.str + signLength, 1) &&
744 EmitAscii(
745 io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
746 EmitAscii(io_, converted.str + signLength + 1,
747 converted.length - (signLength + 1)) &&
748 EmitRepeated(io_, '0', trailingZeroes) &&
749 EmitAscii(io_, exponent, expoLength);
750}
751
752template <int KIND>
753RT_API_ATTRS bool RealOutputEditing<KIND>::Edit(const DataEdit &edit) {
754 const DataEdit *editPtr{&edit};
755 DataEdit newEdit;
756 if (editPtr->descriptor == 'G') {
757 // Avoid recursive call as in Edit(EditForGOutput(edit)).
758 newEdit = EditForGOutput(*editPtr);
759 editPtr = &newEdit;
760 RUNTIME_CHECK(io_.GetIoErrorHandler(), editPtr->descriptor != 'G');
761 }
762 switch (editPtr->descriptor) {
763 case 'D':
764 return EditEorDOutput(*editPtr);
765 case 'E':
766 if (editPtr->variation == 'X') {
767 return EditEXOutput(*editPtr);
768 } else {
769 return EditEorDOutput(*editPtr);
770 }
771 case 'F':
772 return EditFOutput(*editPtr);
773 case 'B':
774 return EditBOZOutput<1>(io_, *editPtr,
775 reinterpret_cast<const unsigned char *>(&x_),
776 common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
777 case 'O':
778 return EditBOZOutput<3>(io_, *editPtr,
779 reinterpret_cast<const unsigned char *>(&x_),
780 common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
781 case 'Z':
782 return EditBOZOutput<4>(io_, *editPtr,
783 reinterpret_cast<const unsigned char *>(&x_),
784 common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
785 case 'L':
786 return EditLogicalOutput(
787 io_, *editPtr, *reinterpret_cast<const char *>(&x_));
788 case 'A': // legacy extension
789 return EditCharacterOutput(
790 io_, *editPtr, reinterpret_cast<char *>(&x_), sizeof x_);
791 default:
792 if (editPtr->IsListDirected()) {
793 return EditListDirectedOutput(*editPtr);
794 }
795 io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
796 "Data edit descriptor '%c' may not be used with a REAL data item",
797 editPtr->descriptor);
798 return false;
799 }
800 return false;
801}
802
803RT_API_ATTRS bool ListDirectedLogicalOutput(IoStatementState &io,
804 ListDirectedStatementState<Direction::Output> &list, bool truth) {
805 return list.EmitLeadingSpaceOrAdvance(io) &&
806 EmitAscii(io, truth ? "T" : "F", 1);
807}
808
809RT_API_ATTRS bool EditLogicalOutput(
810 IoStatementState &io, const DataEdit &edit, bool truth) {
811 switch (edit.descriptor) {
812 case 'L':
813 case 'G':
814 return EmitRepeated(io, ' ', std::max(0, edit.width.value_or(1) - 1)) &&
815 EmitAscii(io, truth ? "T" : "F", 1);
816 case 'B':
817 return EditBOZOutput<1>(io, edit,
818 reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
819 case 'O':
820 return EditBOZOutput<3>(io, edit,
821 reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
822 case 'Z':
823 return EditBOZOutput<4>(io, edit,
824 reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
825 default:
826 io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
827 "Data edit descriptor '%c' may not be used with a LOGICAL data item",
828 edit.descriptor);
829 return false;
830 }
831}
832
833template <typename CHAR>
834RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &io,
835 ListDirectedStatementState<Direction::Output> &list, const CHAR *x,
836 std::size_t length) {
837 bool ok{true};
838 MutableModes &modes{io.mutableModes()};
839 ConnectionState &connection{io.GetConnectionState()};
840 if (modes.delim) {
841 ok = ok && list.EmitLeadingSpaceOrAdvance(io);
842 // Value is delimited with ' or " marks, and interior
843 // instances of that character are doubled.
844 auto EmitOne{[&](CHAR ch) {
845 if (connection.NeedAdvance(1)) {
846 ok = ok && io.AdvanceRecord();
847 }
848 ok = ok && EmitEncoded(io, &ch, 1);
849 }};
850 EmitOne(modes.delim);
851 for (std::size_t j{0}; j < length; ++j) {
852 // Doubled delimiters must be put on the same record
853 // in order to be acceptable as list-directed or NAMELIST
854 // input; however, this requirement is not always possible
855 // when the records have a fixed length, as is the case with
856 // internal output. The standard is silent on what should
857 // happen, and no two extant Fortran implementations do
858 // the same thing when tested with this case.
859 // This runtime splits the doubled delimiters across
860 // two records for lack of a better alternative.
861 if (x[j] == static_cast<CHAR>(modes.delim)) {
862 EmitOne(x[j]);
863 }
864 EmitOne(x[j]);
865 }
866 EmitOne(modes.delim);
867 } else {
868 // Undelimited list-directed output
869 ok = ok && list.EmitLeadingSpaceOrAdvance(io, length > 0 ? 1 : 0, true);
870 std::size_t put{0};
871 std::size_t oneAtATime{
872 connection.useUTF8<CHAR>() || connection.internalIoCharKind > 1
873 ? 1
874 : length};
875 while (ok && put < length) {
876 if (std::size_t chunk{std::min<std::size_t>(
877 std::min<std::size_t>(a: length - put, b: oneAtATime),
878 connection.RemainingSpaceInRecord())}) {
879 ok = EmitEncoded(io, x + put, chunk);
880 put += chunk;
881 } else {
882 ok = io.AdvanceRecord() && EmitAscii(io, " ", 1);
883 }
884 }
885 list.set_lastWasUndelimitedCharacter(true);
886 }
887 return ok;
888}
889
890template <typename CHAR>
891RT_API_ATTRS bool EditCharacterOutput(IoStatementState &io,
892 const DataEdit &edit, const CHAR *x, std::size_t length) {
893 int len{static_cast<int>(length)};
894 int width{edit.width.value_or(len)};
895 switch (edit.descriptor) {
896 case 'A':
897 break;
898 case 'G':
899 if (width == 0) {
900 width = len;
901 }
902 break;
903 case 'B':
904 return EditBOZOutput<1>(io, edit,
905 reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
906 case 'O':
907 return EditBOZOutput<3>(io, edit,
908 reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
909 case 'Z':
910 return EditBOZOutput<4>(io, edit,
911 reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
912 case 'L':
913 return EditLogicalOutput(io, edit, *reinterpret_cast<const char *>(x));
914 default:
915 io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
916 "Data edit descriptor '%c' may not be used with a CHARACTER data item",
917 edit.descriptor);
918 return false;
919 }
920 return EmitRepeated(io, ' ', std::max(a: 0, b: width - len)) &&
921 EmitEncoded(io, x, std::min(a: width, b: len));
922}
923
924template RT_API_ATTRS bool EditIntegerOutput<1>(
925 IoStatementState &, const DataEdit &, std::int8_t);
926template RT_API_ATTRS bool EditIntegerOutput<2>(
927 IoStatementState &, const DataEdit &, std::int16_t);
928template RT_API_ATTRS bool EditIntegerOutput<4>(
929 IoStatementState &, const DataEdit &, std::int32_t);
930template RT_API_ATTRS bool EditIntegerOutput<8>(
931 IoStatementState &, const DataEdit &, std::int64_t);
932template RT_API_ATTRS bool EditIntegerOutput<16>(
933 IoStatementState &, const DataEdit &, common::int128_t);
934
935template class RealOutputEditing<2>;
936template class RealOutputEditing<3>;
937template class RealOutputEditing<4>;
938template class RealOutputEditing<8>;
939template class RealOutputEditing<10>;
940// TODO: double/double
941template class RealOutputEditing<16>;
942
943template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
944 ListDirectedStatementState<Direction::Output> &, const char *,
945 std::size_t chars);
946template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
947 ListDirectedStatementState<Direction::Output> &, const char16_t *,
948 std::size_t chars);
949template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
950 ListDirectedStatementState<Direction::Output> &, const char32_t *,
951 std::size_t chars);
952
953template RT_API_ATTRS bool EditCharacterOutput(
954 IoStatementState &, const DataEdit &, const char *, std::size_t chars);
955template RT_API_ATTRS bool EditCharacterOutput(
956 IoStatementState &, const DataEdit &, const char16_t *, std::size_t chars);
957template RT_API_ATTRS bool EditCharacterOutput(
958 IoStatementState &, const DataEdit &, const char32_t *, std::size_t chars);
959
960RT_OFFLOAD_API_GROUP_END
961} // namespace Fortran::runtime::io
962

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