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

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