llvm-project

1
//===-- runtime/edit-output.cpp -------------------------------------------===//
2
//
3
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4
// See https://llvm.org/LICENSE.txt for license information.
5
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6
//
7
//===----------------------------------------------------------------------===//
8

9
#include "edit-output.h"
10
#include "emit-encoded.h"
11
#include "utf.h"
12
#include "flang/Common/real.h"
13
#include "flang/Common/uint128.h"
14
#include <algorithm>
15

16
namespace Fortran::runtime::io {
17
RT_OFFLOAD_API_GROUP_BEGIN
18

19
// In output statement, add a space between numbers and characters.
20
static RT_API_ATTRS void addSpaceBeforeCharacter(IoStatementState &io) {
21
  if (auto *list{io.get_if<ListDirectedStatementState<Direction::Output>>()}) {
22
    list->set_lastWasUndelimitedCharacter(false);
23
  }
24
}
25

26
// B/O/Z output of arbitrarily sized data emits a binary/octal/hexadecimal
27
// representation of what is interpreted to be a single unsigned integer value.
28
// When used with character data, endianness is exposed.
29
template <int LOG2_BASE>
30
static RT_API_ATTRS bool EditBOZOutput(IoStatementState &io,
31
    const DataEdit &edit, const unsigned char *data0, std::size_t bytes) {
32
  addSpaceBeforeCharacter(io);
33
  int digits{static_cast<int>((bytes * 8) / LOG2_BASE)};
34
  int get{static_cast<int>(bytes * 8) - digits * LOG2_BASE};
35
  if (get > 0) {
36
    ++digits;
37
  } else {
38
    get = LOG2_BASE;
39
  }
40
  int shift{7};
41
  int increment{isHostLittleEndian ? -1 : 1};
42
  const unsigned char *data{data0 + (isHostLittleEndian ? bytes - 1 : 0)};
43
  int skippedZeroes{0};
44
  int digit{0};
45
  // The same algorithm is used to generate digits for real (below)
46
  // as well as for generating them only to skip leading zeroes (here).
47
  // Bits are copied one at a time from the source data.
48
  // TODO: Multiple bit copies for hexadecimal, where misalignment
49
  // is not possible; or for octal when all 3 bits come from the
50
  // same byte.
51
  while (bytes > 0) {
52
    if (get == 0) {
53
      if (digit != 0) {
54
        break; // first nonzero leading digit
55
      }
56
      ++skippedZeroes;
57
      get = LOG2_BASE;
58
    } else if (shift < 0) {
59
      data += increment;
60
      --bytes;
61
      shift = 7;
62
    } else {
63
      digit = 2 * digit + ((*data >> shift--) & 1);
64
      --get;
65
    }
66
  }
67
  // Emit leading spaces and zeroes; detect field overflow
68
  int leadingZeroes{0};
69
  int editWidth{edit.width.value_or(0)};
70
  int significant{digits - skippedZeroes};
71
  if (edit.digits && significant <= *edit.digits) { // Bw.m, Ow.m, Zw.m
72
    if (*edit.digits == 0 && bytes == 0) {
73
      editWidth = std::max(1, editWidth);
74
    } else {
75
      leadingZeroes = *edit.digits - significant;
76
    }
77
  } else if (bytes == 0) {
78
    leadingZeroes = 1;
79
  }
80
  int subTotal{leadingZeroes + significant};
81
  int leadingSpaces{std::max(0, editWidth - subTotal)};
82
  if (editWidth > 0 && leadingSpaces + subTotal > editWidth) {
83
    return EmitRepeated(io, '*', editWidth);
84
  }
85
  if (!(EmitRepeated(io, ' ', leadingSpaces) &&
86
          EmitRepeated(io, '0', leadingZeroes))) {
87
    return false;
88
  }
89
  // Emit remaining digits
90
  while (bytes > 0) {
91
    if (get == 0) {
92
      char ch{static_cast<char>(digit >= 10 ? 'A' + digit - 10 : '0' + digit)};
93
      if (!EmitAscii(io, &ch, 1)) {
94
        return false;
95
      }
96
      get = LOG2_BASE;
97
      digit = 0;
98
    } else if (shift < 0) {
99
      data += increment;
100
      --bytes;
101
      shift = 7;
102
    } else {
103
      digit = 2 * digit + ((*data >> shift--) & 1);
104
      --get;
105
    }
106
  }
107
  return true;
108
}
109

110
template <int KIND>
111
bool RT_API_ATTRS EditIntegerOutput(IoStatementState &io, const DataEdit &edit,
112
    common::HostSignedIntType<8 * KIND> n) {
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(1, editWidth);
166
    } else {
167
      leadingZeroes = *edit.digits - digits;
168
    }
169
  } else if (n == 0) {
170
    leadingZeroes = 1;
171
  }
172
  int subTotal{signChars + leadingZeroes + digits};
173
  int leadingSpaces{std::max(0, editWidth - subTotal)};
174
  if (editWidth > 0 && leadingSpaces + subTotal > editWidth) {
175
    return EmitRepeated(io, '*', editWidth);
176
  }
177
  if (edit.IsListDirected()) {
178
    int total{std::max(leadingSpaces, 1) + subTotal};
179
    if (io.GetConnectionState().NeedAdvance(static_cast<std::size_t>(total)) &&
180
        !io.AdvanceRecord()) {
181
      return false;
182
    }
183
    leadingSpaces = 1;
184
  }
185
  return EmitRepeated(io, ' ', leadingSpaces) &&
186
      EmitAscii(io, n < 0 ? "-" : "+", signChars) &&
187
      EmitRepeated(io, '0', leadingZeroes) && EmitAscii(io, p, digits);
188
}
189

190
// Formats the exponent (see table 13.1 for all the cases)
191
RT_API_ATTRS const char *RealOutputEditingBase::FormatExponent(
192
    int expo, const DataEdit &edit, int &length) {
193
  char *eEnd{&exponent_[sizeof exponent_]};
194
  char *exponent{eEnd};
195
  for (unsigned e{static_cast<unsigned>(std::abs(expo))}; e > 0;) {
196
    unsigned quotient{e / 10u};
197
    *--exponent = '0' + e - 10 * quotient;
198
    e = quotient;
199
  }
200
  bool overflow{false};
201
  if (edit.expoDigits) {
202
    if (int ed{*edit.expoDigits}) { // Ew.dEe with e > 0
203
      overflow = exponent + ed < eEnd;
204
      while (exponent > exponent_ + 2 /*E+*/ && exponent + ed > eEnd) {
205
        *--exponent = '0';
206
      }
207
    } else if (exponent == eEnd) {
208
      *--exponent = '0'; // Ew.dE0 with zero-valued exponent
209
    }
210
  } else if (edit.variation == 'X') {
211
    if (expo == 0) {
212
      *--exponent = '0'; // EX without Ee and zero-valued exponent
213
    }
214
  } else {
215
    // Ensure at least two exponent digits unless EX
216
    while (exponent + 2 > eEnd) {
217
      *--exponent = '0';
218
    }
219
  }
220
  *--exponent = expo < 0 ? '-' : '+';
221
  if (edit.variation == 'X') {
222
    *--exponent = 'P';
223
  } else if (edit.expoDigits || edit.IsListDirected() || exponent + 3 == eEnd) {
224
    *--exponent = edit.descriptor == 'D' ? 'D' : 'E'; // not 'G' or 'Q'
225
  }
226
  length = eEnd - exponent;
227
  return overflow ? nullptr : exponent;
228
}
229

230
RT_API_ATTRS bool RealOutputEditingBase::EmitPrefix(
231
    const DataEdit &edit, std::size_t length, std::size_t width) {
232
  if (edit.IsListDirected()) {
233
    int prefixLength{edit.descriptor == DataEdit::ListDirectedRealPart ? 2
234
            : edit.descriptor == DataEdit::ListDirectedImaginaryPart   ? 0
235
                                                                       : 1};
236
    int suffixLength{edit.descriptor == DataEdit::ListDirectedRealPart ||
237
                edit.descriptor == DataEdit::ListDirectedImaginaryPart
238
            ? 1
239
            : 0};
240
    length += prefixLength + suffixLength;
241
    ConnectionState &connection{io_.GetConnectionState()};
242
    return (!connection.NeedAdvance(length) || io_.AdvanceRecord()) &&
243
        EmitAscii(io_, " (", prefixLength);
244
  } else if (width > length) {
245
    return EmitRepeated(io_, ' ', width - length);
246
  } else {
247
    return true;
248
  }
249
}
250

251
RT_API_ATTRS bool RealOutputEditingBase::EmitSuffix(const DataEdit &edit) {
252
  if (edit.descriptor == DataEdit::ListDirectedRealPart) {
253
    return EmitAscii(
254
        io_, edit.modes.editingFlags & decimalComma ? ";" : ",", 1);
255
  } else if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
256
    return EmitAscii(io_, ")", 1);
257
  } else {
258
    return true;
259
  }
260
}
261

262
template <int KIND>
263
RT_API_ATTRS decimal::ConversionToDecimalResult
264
RealOutputEditing<KIND>::ConvertToDecimal(
265
    int significantDigits, enum decimal::FortranRounding rounding, int flags) {
266
  auto converted{decimal::ConvertToDecimal<binaryPrecision>(buffer_,
267
      sizeof buffer_, static_cast<enum decimal::DecimalConversionFlags>(flags),
268
      significantDigits, rounding, x_)};
269
  if (!converted.str) { // overflow
270
    io_.GetIoErrorHandler().Crash(
271
        "RealOutputEditing::ConvertToDecimal: buffer size %zd was insufficient",
272
        sizeof buffer_);
273
  }
274
  return converted;
275
}
276

277
static RT_API_ATTRS bool IsInfOrNaN(const char *p, int length) {
278
  if (!p || length < 1) {
279
    return false;
280
  }
281
  if (*p == '-' || *p == '+') {
282
    if (length == 1) {
283
      return false;
284
    }
285
    ++p;
286
  }
287
  return *p == 'I' || *p == 'N';
288
}
289

290
// 13.7.2.3.3 in F'2018
291
template <int KIND>
292
RT_API_ATTRS bool RealOutputEditing<KIND>::EditEorDOutput(
293
    const DataEdit &edit) {
294
  addSpaceBeforeCharacter(io_);
295
  int editDigits{edit.digits.value_or(0)}; // 'd' field
296
  int editWidth{edit.width.value_or(0)}; // 'w' field
297
  int significantDigits{editDigits};
298
  int flags{0};
299
  if (edit.modes.editingFlags & signPlus) {
300
    flags |= decimal::AlwaysSign;
301
  }
302
  int scale{edit.modes.scale}; // 'kP' value
303
  if (editWidth == 0) { // "the processor selects the field width"
304
    if (edit.digits.has_value()) { // E0.d
305
      if (editDigits == 0 && scale <= 0) { // E0.0
306
        significantDigits = 1;
307
      }
308
    } else { // E0
309
      flags |= decimal::Minimize;
310
      significantDigits =
311
          sizeof buffer_ - 5; // sign, NUL, + 3 extra for EN scaling
312
    }
313
  }
314
  bool isEN{edit.variation == 'N'};
315
  bool isES{edit.variation == 'S'};
316
  int zeroesAfterPoint{0};
317
  if (isEN) {
318
    scale = IsZero() ? 1 : 3;
319
    significantDigits += scale;
320
  } else if (isES) {
321
    scale = 1;
322
    ++significantDigits;
323
  } else if (scale < 0) {
324
    if (scale <= -editDigits) {
325
      io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor,
326
          "Scale factor (kP) %d cannot be less than -d (%d)", scale,
327
          -editDigits);
328
      return false;
329
    }
330
    zeroesAfterPoint = -scale;
331
    significantDigits = std::max(0, significantDigits - zeroesAfterPoint);
332
  } else if (scale > 0) {
333
    if (scale >= editDigits + 2) {
334
      io_.GetIoErrorHandler().SignalError(IostatBadScaleFactor,
335
          "Scale factor (kP) %d cannot be greater than d+2 (%d)", scale,
336
          editDigits + 2);
337
      return false;
338
    }
339
    ++significantDigits;
340
    scale = std::min(scale, significantDigits + 1);
341
  } else if (edit.digits.value_or(1) == 0 && !edit.variation) {
342
    // F'2023 13.7.2.3.3 p5; does not apply to Gw.0(Ee) or E0(no d)
343
    io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
344
        "Output edit descriptor %cw.d must have d>0", edit.descriptor);
345
    return false;
346
  }
347
  // In EN editing, multiple attempts may be necessary, so this is a loop.
348
  while (true) {
349
    decimal::ConversionToDecimalResult converted{
350
        ConvertToDecimal(significantDigits, edit.modes.round, flags)};
351
    if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
352
      return editWidth > 0 &&
353
              converted.length + trailingBlanks_ >
354
                  static_cast<std::size_t>(editWidth)
355
          ? EmitRepeated(io_, '*', editWidth)
356
          : EmitPrefix(edit, converted.length, editWidth) &&
357
              EmitAscii(io_, converted.str, converted.length) &&
358
              EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit);
359
    }
360
    if (!IsZero()) {
361
      converted.decimalExponent -= scale;
362
    }
363
    if (isEN) {
364
      // EN mode: we need an effective exponent field that is
365
      // a multiple of three.
366
      if (int modulus{converted.decimalExponent % 3}; modulus != 0) {
367
        if (significantDigits > 1) {
368
          --significantDigits;
369
          --scale;
370
          continue;
371
        }
372
        // Rounded nines up to a 1.
373
        scale += modulus;
374
        converted.decimalExponent -= modulus;
375
      }
376
      if (scale > 3) {
377
        int adjust{3 * (scale / 3)};
378
        scale -= adjust;
379
        converted.decimalExponent += adjust;
380
      } else if (scale < 1) {
381
        int adjust{3 - 3 * (scale / 3)};
382
        scale += adjust;
383
        converted.decimalExponent -= adjust;
384
      }
385
      significantDigits = editDigits + scale;
386
    }
387
    // Format the exponent (see table 13.1 for all the cases)
388
    int expoLength{0};
389
    const char *exponent{
390
        FormatExponent(converted.decimalExponent, edit, expoLength)};
391
    int signLength{*converted.str == '-' || *converted.str == '+' ? 1 : 0};
392
    int convertedDigits{static_cast<int>(converted.length) - signLength};
393
    int zeroesBeforePoint{std::max(0, scale - convertedDigits)};
394
    int digitsBeforePoint{std::max(0, scale - zeroesBeforePoint)};
395
    int digitsAfterPoint{convertedDigits - digitsBeforePoint};
396
    int trailingZeroes{flags & decimal::Minimize
397
            ? 0
398
            : std::max(0,
399
                  significantDigits - (convertedDigits + zeroesBeforePoint))};
400
    int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
401
        1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
402
        expoLength};
403
    int width{editWidth > 0 ? editWidth : totalLength};
404
    if (totalLength > width || !exponent) {
405
      return EmitRepeated(io_, '*', width);
406
    }
407
    if (totalLength < width && digitsBeforePoint == 0 &&
408
        zeroesBeforePoint == 0) {
409
      zeroesBeforePoint = 1;
410
      ++totalLength;
411
    }
412
    if (totalLength < width && editWidth == 0) {
413
      width = totalLength;
414
    }
415
    return EmitPrefix(edit, totalLength, width) &&
416
        EmitAscii(io_, converted.str, signLength + digitsBeforePoint) &&
417
        EmitRepeated(io_, '0', zeroesBeforePoint) &&
418
        EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
419
        EmitRepeated(io_, '0', zeroesAfterPoint) &&
420
        EmitAscii(io_, converted.str + signLength + digitsBeforePoint,
421
            digitsAfterPoint) &&
422
        EmitRepeated(io_, '0', trailingZeroes) &&
423
        EmitAscii(io_, exponent, expoLength) && EmitSuffix(edit);
424
  }
425
}
426

427
// 13.7.2.3.2 in F'2018
428
template <int KIND>
429
RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
430
  addSpaceBeforeCharacter(io_);
431
  int fracDigits{edit.digits.value_or(0)}; // 'd' field
432
  const int editWidth{edit.width.value_or(0)}; // 'w' field
433
  enum decimal::FortranRounding rounding{edit.modes.round};
434
  int flags{0};
435
  if (edit.modes.editingFlags & signPlus) {
436
    flags |= decimal::AlwaysSign;
437
  }
438
  if (editWidth == 0) { // "the processor selects the field width"
439
    if (!edit.digits.has_value()) { // F0
440
      flags |= decimal::Minimize;
441
      fracDigits = sizeof buffer_ - 2; // sign & NUL
442
    }
443
  }
444
  bool emitTrailingZeroes{!(flags & decimal::Minimize)};
445
  // Multiple conversions may be needed to get the right number of
446
  // effective rounded fractional digits.
447
  bool canIncrease{true};
448
  for (int extraDigits{fracDigits == 0 ? 1 : 0};;) {
449
    decimal::ConversionToDecimalResult converted{
450
        ConvertToDecimal(extraDigits + fracDigits, rounding, flags)};
451
    const char *convertedStr{converted.str};
452
    if (IsInfOrNaN(convertedStr, static_cast<int>(converted.length))) {
453
      return editWidth > 0 &&
454
              converted.length > static_cast<std::size_t>(editWidth)
455
          ? EmitRepeated(io_, '*', editWidth)
456
          : EmitPrefix(edit, converted.length, editWidth) &&
457
              EmitAscii(io_, convertedStr, converted.length) &&
458
              EmitSuffix(edit);
459
    }
460
    int expo{converted.decimalExponent + edit.modes.scale /*kP*/};
461
    int signLength{*convertedStr == '-' || *convertedStr == '+' ? 1 : 0};
462
    int convertedDigits{static_cast<int>(converted.length) - signLength};
463
    if (IsZero()) { // don't treat converted "0" as significant digit
464
      expo = 0;
465
      convertedDigits = 0;
466
    }
467
    bool isNegative{*convertedStr == '-'};
468
    char one[2];
469
    if (expo > extraDigits && extraDigits >= 0 && canIncrease) {
470
      extraDigits = expo;
471
      if (!edit.digits.has_value()) { // F0
472
        fracDigits = sizeof buffer_ - extraDigits - 2; // sign & NUL
473
      }
474
      canIncrease = false; // only once
475
      continue;
476
    } else if (expo == -fracDigits && convertedDigits > 0) {
477
      // Result will be either a signed zero or power of ten, depending
478
      // on rounding.
479
      char leading{convertedStr[signLength]};
480
      bool roundToPowerOfTen{false};
481
      switch (edit.modes.round) {
482
      case decimal::FortranRounding::RoundUp:
483
        roundToPowerOfTen = !isNegative;
484
        break;
485
      case decimal::FortranRounding::RoundDown:
486
        roundToPowerOfTen = isNegative;
487
        break;
488
      case decimal::FortranRounding::RoundToZero:
489
        break;
490
      case decimal::FortranRounding::RoundNearest:
491
        if (leading == '5' &&
492
            rounding == decimal::FortranRounding::RoundNearest) {
493
          // Try again, rounding away from zero.
494
          rounding = isNegative ? decimal::FortranRounding::RoundDown
495
                                : decimal::FortranRounding::RoundUp;
496
          extraDigits = 1 - fracDigits; // just one digit needed
497
          continue;
498
        }
499
        roundToPowerOfTen = leading > '5';
500
        break;
501
      case decimal::FortranRounding::RoundCompatible:
502
        roundToPowerOfTen = leading >= '5';
503
        break;
504
      }
505
      if (roundToPowerOfTen) {
506
        ++expo;
507
        convertedDigits = 1;
508
        if (signLength > 0) {
509
          one[0] = *convertedStr;
510
          one[1] = '1';
511
        } else {
512
          one[0] = '1';
513
        }
514
        convertedStr = one;
515
      } else {
516
        expo = 0;
517
        convertedDigits = 0;
518
      }
519
    } else if (expo < extraDigits && extraDigits > -fracDigits) {
520
      extraDigits = std::max(expo, -fracDigits);
521
      continue;
522
    }
523
    int digitsBeforePoint{std::max(0, std::min(expo, convertedDigits))};
524
    int zeroesBeforePoint{std::max(0, expo - digitsBeforePoint)};
525
    if (zeroesBeforePoint > 0 && (flags & decimal::Minimize)) {
526
      // If a minimized result looks like an integer, emit all of
527
      // its digits rather than clipping some to zeroes.
528
      // This can happen with HUGE(0._2) == 65504._2.
529
      flags &= ~decimal::Minimize;
530
      continue;
531
    }
532
    int zeroesAfterPoint{std::min(fracDigits, std::max(0, -expo))};
533
    int digitsAfterPoint{convertedDigits - digitsBeforePoint};
534
    int trailingZeroes{emitTrailingZeroes
535
            ? std::max(0, fracDigits - (zeroesAfterPoint + digitsAfterPoint))
536
            : 0};
537
    if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint +
538
            digitsAfterPoint + trailingZeroes ==
539
        0) {
540
      zeroesBeforePoint = 1; // "." -> "0."
541
    }
542
    int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
543
        1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
544
        trailingBlanks_ /* G editing converted to F */};
545
    int width{editWidth > 0 || trailingBlanks_ ? editWidth : totalLength};
546
    if (totalLength > width) {
547
      return EmitRepeated(io_, '*', width);
548
    }
549
    if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
550
      zeroesBeforePoint = 1;
551
      ++totalLength;
552
    }
553
    return EmitPrefix(edit, totalLength, width) &&
554
        EmitAscii(io_, convertedStr, signLength + digitsBeforePoint) &&
555
        EmitRepeated(io_, '0', zeroesBeforePoint) &&
556
        EmitAscii(io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
557
        EmitRepeated(io_, '0', zeroesAfterPoint) &&
558
        EmitAscii(io_, convertedStr + signLength + digitsBeforePoint,
559
            digitsAfterPoint) &&
560
        EmitRepeated(io_, '0', trailingZeroes) &&
561
        EmitRepeated(io_, ' ', trailingBlanks_) && EmitSuffix(edit);
562
  }
563
}
564

565
// 13.7.5.2.3 in F'2018
566
template <int KIND>
567
RT_API_ATTRS DataEdit RealOutputEditing<KIND>::EditForGOutput(DataEdit edit) {
568
  edit.descriptor = 'E';
569
  edit.variation = 'G'; // to suppress error for Ew.0
570
  int editWidth{edit.width.value_or(0)};
571
  int significantDigits{edit.digits.value_or(
572
      static_cast<int>(BinaryFloatingPoint::decimalPrecision))}; // 'd'
573
  if (editWidth > 0 && significantDigits == 0) {
574
    return edit; // Gw.0Ee -> Ew.0Ee for w > 0
575
  }
576
  int flags{0};
577
  if (edit.modes.editingFlags & signPlus) {
578
    flags |= decimal::AlwaysSign;
579
  }
580
  decimal::ConversionToDecimalResult converted{
581
      ConvertToDecimal(significantDigits, edit.modes.round, flags)};
582
  if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
583
    return edit; // Inf/Nan -> Ew.d (same as Fw.d)
584
  }
585
  int expo{IsZero() ? 1 : converted.decimalExponent}; // 's'
586
  if (expo < 0 || expo > significantDigits) {
587
    if (editWidth == 0 && !edit.expoDigits) { // G0.d -> G0.dE0
588
      edit.expoDigits = 0;
589
    }
590
    return edit; // Ew.dEe
591
  }
592
  edit.descriptor = 'F';
593
  edit.modes.scale = 0; // kP is ignored for G when no exponent field
594
  trailingBlanks_ = 0;
595
  if (editWidth > 0) {
596
    int expoDigits{edit.expoDigits.value_or(0)};
597
    // F'2023 13.7.5.2.3 p5: "If 0 <= s <= d, the scale factor has no effect
598
    // and F(w − n).(d − s),n(’b’) editing is used where b is a blank and
599
    // n is 4 for Gw.d editing, e + 2 for Gw.dEe editing if e > 0, and
600
    // 4 for Gw.dE0 editing."
601
    trailingBlanks_ = expoDigits > 0 ? expoDigits + 2 : 4; // 'n'
602
  }
603
  if (edit.digits.has_value()) {
604
    *edit.digits = std::max(0, *edit.digits - expo);
605
  }
606
  return edit;
607
}
608

609
// 13.10.4 in F'2018
610
template <int KIND>
611
RT_API_ATTRS bool RealOutputEditing<KIND>::EditListDirectedOutput(
612
    const DataEdit &edit) {
613
  decimal::ConversionToDecimalResult converted{
614
      ConvertToDecimal(1, edit.modes.round)};
615
  if (IsInfOrNaN(converted.str, static_cast<int>(converted.length))) {
616
    DataEdit copy{edit};
617
    copy.variation = DataEdit::ListDirected;
618
    return EditEorDOutput(copy);
619
  }
620
  int expo{converted.decimalExponent};
621
  // The decimal precision of 16-bit floating-point types is very low,
622
  // so use a reasonable cap of 6 to allow more values to be emitted
623
  // with Fw.d editing.
624
  static constexpr int maxExpo{
625
      std::max(6, BinaryFloatingPoint::decimalPrecision)};
626
  if (expo < 0 || expo > maxExpo) {
627
    DataEdit copy{edit};
628
    copy.variation = DataEdit::ListDirected;
629
    copy.modes.scale = 1; // 1P
630
    return EditEorDOutput(copy);
631
  } else {
632
    return EditFOutput(edit);
633
  }
634
}
635

636
// 13.7.2.3.6 in F'2023
637
// The specification for hexadecimal output, unfortunately for implementors,
638
// leaves as "implementation dependent" the choice of how to emit values
639
// with multiple hexadecimal output possibilities that are numerically
640
// equivalent.  The one working implementation of EX output that I can find
641
// apparently chooses to frame the nybbles from most to least significant,
642
// rather than trying to minimize the magnitude of the binary exponent.
643
// E.g., 2. is edited into 0X8.0P-2 rather than 0X2.0P0.  This implementation
644
// follows that precedent so as to avoid a gratuitous incompatibility.
645
template <int KIND>
646
RT_API_ATTRS auto RealOutputEditing<KIND>::ConvertToHexadecimal(
647
    int significantDigits, enum decimal::FortranRounding rounding,
648
    int flags) -> ConvertToHexadecimalResult {
649
  if (x_.IsNaN() || x_.IsInfinite()) {
650
    auto converted{ConvertToDecimal(significantDigits, rounding, flags)};
651
    return {converted.str, static_cast<int>(converted.length), 0};
652
  }
653
  x_.RoundToBits(4 * significantDigits, rounding);
654
  if (x_.IsInfinite()) { // rounded away to +/-Inf
655
    auto converted{ConvertToDecimal(significantDigits, rounding, flags)};
656
    return {converted.str, static_cast<int>(converted.length), 0};
657
  }
658
  int len{0};
659
  if (x_.IsNegative()) {
660
    buffer_[len++] = '-';
661
  } else if (flags & decimal::AlwaysSign) {
662
    buffer_[len++] = '+';
663
  }
664
  auto fraction{x_.Fraction()};
665
  if (fraction == 0) {
666
    buffer_[len++] = '0';
667
    return {buffer_, len, 0};
668
  } else {
669
    // Ensure that the MSB is set.
670
    int expo{x_.UnbiasedExponent() - 3};
671
    while (!(fraction >> (x_.binaryPrecision - 1))) {
672
      fraction <<= 1;
673
      --expo;
674
    }
675
    // This is initially the right shift count needed to bring the
676
    // most-significant hexadecimal digit's bits into the LSBs.
677
    // x_.binaryPrecision is constant, so / can be used for readability.
678
    int shift{x_.binaryPrecision - 4};
679
    typename BinaryFloatingPoint::RawType one{1};
680
    auto remaining{(one << x_.binaryPrecision) - one};
681
    for (int digits{0}; digits < significantDigits; ++digits) {
682
      if ((flags & decimal::Minimize) && !(fraction & remaining)) {
683
        break;
684
      }
685
      int hexDigit{0};
686
      if (shift >= 0) {
687
        hexDigit = int(fraction >> shift) & 0xf;
688
      } else if (shift >= -3) {
689
        hexDigit = int(fraction << -shift) & 0xf;
690
      }
691
      if (hexDigit >= 10) {
692
        buffer_[len++] = 'A' + hexDigit - 10;
693
      } else {
694
        buffer_[len++] = '0' + hexDigit;
695
      }
696
      shift -= 4;
697
      remaining >>= 4;
698
    }
699
    return {buffer_, len, expo};
700
  }
701
}
702

703
template <int KIND>
704
RT_API_ATTRS bool RealOutputEditing<KIND>::EditEXOutput(const DataEdit &edit) {
705
  addSpaceBeforeCharacter(io_);
706
  int editDigits{edit.digits.value_or(0)}; // 'd' field
707
  int significantDigits{editDigits + 1};
708
  int flags{0};
709
  if (edit.modes.editingFlags & signPlus) {
710
    flags |= decimal::AlwaysSign;
711
  }
712
  int editWidth{edit.width.value_or(0)}; // 'w' field
713
  if ((editWidth == 0 && !edit.digits) || editDigits == 0) {
714
    // EX0 or EXw.0
715
    flags |= decimal::Minimize;
716
    static constexpr int maxSigHexDigits{
717
        (common::PrecisionOfRealKind(16) + 3) / 4};
718
    significantDigits = maxSigHexDigits;
719
  }
720
  auto converted{
721
      ConvertToHexadecimal(significantDigits, edit.modes.round, flags)};
722
  if (IsInfOrNaN(converted.str, converted.length)) {
723
    return editWidth > 0 && converted.length > editWidth
724
        ? EmitRepeated(io_, '*', editWidth)
725
        : (editWidth <= converted.length ||
726
              EmitRepeated(io_, ' ', editWidth - converted.length)) &&
727
            EmitAscii(io_, converted.str, converted.length);
728
  }
729
  int signLength{converted.length > 0 &&
730
              (converted.str[0] == '-' || converted.str[0] == '+')
731
          ? 1
732
          : 0};
733
  int convertedDigits{converted.length - signLength};
734
  int expoLength{0};
735
  const char *exponent{FormatExponent(converted.exponent, edit, expoLength)};
736
  int trailingZeroes{flags & decimal::Minimize
737
          ? 0
738
          : std::max(0, significantDigits - convertedDigits)};
739
  int totalLength{converted.length + trailingZeroes + expoLength + 3 /*0X.*/};
740
  int width{editWidth > 0 ? editWidth : totalLength};
741
  return totalLength > width || !exponent
742
      ? EmitRepeated(io_, '*', width)
743
      : EmitRepeated(io_, ' ', width - totalLength) &&
744
          EmitAscii(io_, converted.str, signLength) &&
745
          EmitAscii(io_, "0X", 2) &&
746
          EmitAscii(io_, converted.str + signLength, 1) &&
747
          EmitAscii(
748
              io_, edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
749
          EmitAscii(io_, converted.str + signLength + 1,
750
              converted.length - (signLength + 1)) &&
751
          EmitRepeated(io_, '0', trailingZeroes) &&
752
          EmitAscii(io_, exponent, expoLength);
753
}
754

755
template <int KIND>
756
RT_API_ATTRS bool RealOutputEditing<KIND>::Edit(const DataEdit &edit) {
757
  const DataEdit *editPtr{&edit};
758
  DataEdit newEdit;
759
  if (editPtr->descriptor == 'G') {
760
    // Avoid recursive call as in Edit(EditForGOutput(edit)).
761
    newEdit = EditForGOutput(*editPtr);
762
    editPtr = &newEdit;
763
    RUNTIME_CHECK(io_.GetIoErrorHandler(), editPtr->descriptor != 'G');
764
  }
765
  switch (editPtr->descriptor) {
766
  case 'D':
767
    return EditEorDOutput(*editPtr);
768
  case 'E':
769
    if (editPtr->variation == 'X') {
770
      return EditEXOutput(*editPtr);
771
    } else {
772
      return EditEorDOutput(*editPtr);
773
    }
774
  case 'F':
775
    return EditFOutput(*editPtr);
776
  case 'B':
777
    return EditBOZOutput<1>(io_, *editPtr,
778
        reinterpret_cast<const unsigned char *>(&x_),
779
        common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
780
  case 'O':
781
    return EditBOZOutput<3>(io_, *editPtr,
782
        reinterpret_cast<const unsigned char *>(&x_),
783
        common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
784
  case 'Z':
785
    return EditBOZOutput<4>(io_, *editPtr,
786
        reinterpret_cast<const unsigned char *>(&x_),
787
        common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
788
  case 'L':
789
    return EditLogicalOutput(
790
        io_, *editPtr, *reinterpret_cast<const char *>(&x_));
791
  case 'A': // legacy extension
792
    return EditCharacterOutput(
793
        io_, *editPtr, reinterpret_cast<char *>(&x_), sizeof x_);
794
  default:
795
    if (editPtr->IsListDirected()) {
796
      return EditListDirectedOutput(*editPtr);
797
    }
798
    io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
799
        "Data edit descriptor '%c' may not be used with a REAL data item",
800
        editPtr->descriptor);
801
    return false;
802
  }
803
  return false;
804
}
805

806
RT_API_ATTRS bool ListDirectedLogicalOutput(IoStatementState &io,
807
    ListDirectedStatementState<Direction::Output> &list, bool truth) {
808
  return list.EmitLeadingSpaceOrAdvance(io) &&
809
      EmitAscii(io, truth ? "T" : "F", 1);
810
}
811

812
RT_API_ATTRS bool EditLogicalOutput(
813
    IoStatementState &io, const DataEdit &edit, bool truth) {
814
  switch (edit.descriptor) {
815
  case 'L':
816
  case 'G':
817
    return EmitRepeated(io, ' ', std::max(0, edit.width.value_or(1) - 1)) &&
818
        EmitAscii(io, truth ? "T" : "F", 1);
819
  case 'B':
820
    return EditBOZOutput<1>(io, edit,
821
        reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
822
  case 'O':
823
    return EditBOZOutput<3>(io, edit,
824
        reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
825
  case 'Z':
826
    return EditBOZOutput<4>(io, edit,
827
        reinterpret_cast<const unsigned char *>(&truth), sizeof truth);
828
  case 'A': { // legacy extension
829
    int truthBits{truth};
830
    int len{sizeof truthBits};
831
    int width{edit.width.value_or(len)};
832
    return EmitRepeated(io, ' ', std::max(0, width - len)) &&
833
        EmitEncoded(
834
            io, reinterpret_cast<char *>(&truthBits), std::min(width, len));
835
  }
836
  default:
837
    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
838
        "Data edit descriptor '%c' may not be used with a LOGICAL data item",
839
        edit.descriptor);
840
    return false;
841
  }
842
}
843

844
template <typename CHAR>
845
RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &io,
846
    ListDirectedStatementState<Direction::Output> &list, const CHAR *x,
847
    std::size_t length) {
848
  bool ok{true};
849
  MutableModes &modes{io.mutableModes()};
850
  ConnectionState &connection{io.GetConnectionState()};
851
  if (modes.delim) {
852
    ok = ok && list.EmitLeadingSpaceOrAdvance(io);
853
    // Value is delimited with ' or " marks, and interior
854
    // instances of that character are doubled.
855
    auto EmitOne{[&](CHAR ch) {
856
      if (connection.NeedAdvance(1)) {
857
        ok = ok && io.AdvanceRecord();
858
      }
859
      ok = ok && EmitEncoded(io, &ch, 1);
860
    }};
861
    EmitOne(modes.delim);
862
    for (std::size_t j{0}; j < length; ++j) {
863
      // Doubled delimiters must be put on the same record
864
      // in order to be acceptable as list-directed or NAMELIST
865
      // input; however, this requirement is not always possible
866
      // when the records have a fixed length, as is the case with
867
      // internal output.  The standard is silent on what should
868
      // happen, and no two extant Fortran implementations do
869
      // the same thing when tested with this case.
870
      // This runtime splits the doubled delimiters across
871
      // two records for lack of a better alternative.
872
      if (x[j] == static_cast<CHAR>(modes.delim)) {
873
        EmitOne(x[j]);
874
      }
875
      EmitOne(x[j]);
876
    }
877
    EmitOne(modes.delim);
878
  } else {
879
    // Undelimited list-directed output
880
    ok = ok && list.EmitLeadingSpaceOrAdvance(io, length > 0 ? 1 : 0, true);
881
    std::size_t put{0};
882
    std::size_t oneAtATime{
883
        connection.useUTF8<CHAR>() || connection.internalIoCharKind > 1
884
            ? 1
885
            : length};
886
    while (ok && put < length) {
887
      if (std::size_t chunk{std::min<std::size_t>(
888
              std::min<std::size_t>(length - put, oneAtATime),
889
              connection.RemainingSpaceInRecord())}) {
890
        ok = EmitEncoded(io, x + put, chunk);
891
        put += chunk;
892
      } else {
893
        ok = io.AdvanceRecord() && EmitAscii(io, " ", 1);
894
      }
895
    }
896
    list.set_lastWasUndelimitedCharacter(true);
897
  }
898
  return ok;
899
}
900

901
template <typename CHAR>
902
RT_API_ATTRS bool EditCharacterOutput(IoStatementState &io,
903
    const DataEdit &edit, const CHAR *x, std::size_t length) {
904
  int len{static_cast<int>(length)};
905
  int width{edit.width.value_or(len)};
906
  switch (edit.descriptor) {
907
  case 'A':
908
    break;
909
  case 'G':
910
    if (width == 0) {
911
      width = len;
912
    }
913
    break;
914
  case 'B':
915
    return EditBOZOutput<1>(io, edit,
916
        reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
917
  case 'O':
918
    return EditBOZOutput<3>(io, edit,
919
        reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
920
  case 'Z':
921
    return EditBOZOutput<4>(io, edit,
922
        reinterpret_cast<const unsigned char *>(x), sizeof(CHAR) * length);
923
  case 'L':
924
    return EditLogicalOutput(io, edit, *reinterpret_cast<const char *>(x));
925
  default:
926
    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
927
        "Data edit descriptor '%c' may not be used with a CHARACTER data item",
928
        edit.descriptor);
929
    return false;
930
  }
931
  return EmitRepeated(io, ' ', std::max(0, width - len)) &&
932
      EmitEncoded(io, x, std::min(width, len));
933
}
934

935
template RT_API_ATTRS bool EditIntegerOutput<1>(
936
    IoStatementState &, const DataEdit &, std::int8_t);
937
template RT_API_ATTRS bool EditIntegerOutput<2>(
938
    IoStatementState &, const DataEdit &, std::int16_t);
939
template RT_API_ATTRS bool EditIntegerOutput<4>(
940
    IoStatementState &, const DataEdit &, std::int32_t);
941
template RT_API_ATTRS bool EditIntegerOutput<8>(
942
    IoStatementState &, const DataEdit &, std::int64_t);
943
template RT_API_ATTRS bool EditIntegerOutput<16>(
944
    IoStatementState &, const DataEdit &, common::int128_t);
945

946
template class RealOutputEditing<2>;
947
template class RealOutputEditing<3>;
948
template class RealOutputEditing<4>;
949
template class RealOutputEditing<8>;
950
template class RealOutputEditing<10>;
951
// TODO: double/double
952
template class RealOutputEditing<16>;
953

954
template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
955
    ListDirectedStatementState<Direction::Output> &, const char *,
956
    std::size_t chars);
957
template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
958
    ListDirectedStatementState<Direction::Output> &, const char16_t *,
959
    std::size_t chars);
960
template RT_API_ATTRS bool ListDirectedCharacterOutput(IoStatementState &,
961
    ListDirectedStatementState<Direction::Output> &, const char32_t *,
962
    std::size_t chars);
963

964
template RT_API_ATTRS bool EditCharacterOutput(
965
    IoStatementState &, const DataEdit &, const char *, std::size_t chars);
966
template RT_API_ATTRS bool EditCharacterOutput(
967
    IoStatementState &, const DataEdit &, const char16_t *, std::size_t chars);
968
template RT_API_ATTRS bool EditCharacterOutput(
969
    IoStatementState &, const DataEdit &, const char32_t *, std::size_t chars);
970

971
RT_OFFLOAD_API_GROUP_END
972
} // namespace Fortran::runtime::io
973