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 "flang/Common/uint128.h"
11 #include <algorithm>
12 
13 namespace Fortran::runtime::io {
14 
15 template <int KIND>
16 bool EditIntegerOutput(IoStatementState &io, const DataEdit &edit,
17     common::HostSignedIntType<8 * KIND> n) {
18   char buffer[130], *end{&buffer[sizeof buffer]}, *p{end};
19   bool isNegative{n < 0};
20   using Unsigned = common::HostUnsignedIntType<8 * KIND>;
21   Unsigned un{static_cast<Unsigned>(n)};
22   int signChars{0};
23   switch (edit.descriptor) {
24   case DataEdit::ListDirected:
25   case 'G':
26   case 'I':
27     if (isNegative) {
28       un = -un;
29     }
30     if (isNegative || (edit.modes.editingFlags & signPlus)) {
31       signChars = 1; // '-' or '+'
32     }
33     while (un > 0) {
34       auto quotient{un / 10u};
35       *--p = '0' + static_cast<int>(un - Unsigned{10} * quotient);
36       un = quotient;
37     }
38     break;
39   case 'B':
40     for (; un > 0; un >>= 1) {
41       *--p = '0' + (static_cast<int>(un) & 1);
42     }
43     break;
44   case 'O':
45     for (; un > 0; un >>= 3) {
46       *--p = '0' + (static_cast<int>(un) & 7);
47     }
48     break;
49   case 'Z':
50     for (; un > 0; un >>= 4) {
51       int digit = static_cast<int>(un) & 0xf;
52       *--p = digit >= 10 ? 'A' + (digit - 10) : '0' + digit;
53     }
54     break;
55   case 'A': // legacy extension
56     return EditDefaultCharacterOutput(
57         io, edit, reinterpret_cast<char *>(&n), sizeof n);
58   default:
59     io.GetIoErrorHandler().Crash(
60         "Data edit descriptor '%c' may not be used with an INTEGER data item",
61         edit.descriptor);
62     return false;
63   }
64 
65   int digits = end - p;
66   int leadingZeroes{0};
67   int editWidth{edit.width.value_or(0)};
68   if (edit.digits && digits <= *edit.digits) { // Iw.m
69     if (*edit.digits == 0 && n == 0) {
70       // Iw.0 with zero value: output field must be blank.  For I0.0
71       // and a zero value, emit one blank character.
72       signChars = 0; // in case of SP
73       editWidth = std::max(1, editWidth);
74     } else {
75       leadingZeroes = *edit.digits - digits;
76     }
77   } else if (n == 0) {
78     leadingZeroes = 1;
79   }
80   int subTotal{signChars + leadingZeroes + digits};
81   int leadingSpaces{std::max(0, editWidth - subTotal)};
82   if (editWidth > 0 && leadingSpaces + subTotal > editWidth) {
83     return io.EmitRepeated('*', editWidth);
84   }
85   if (edit.IsListDirected()) {
86     int total{std::max(leadingSpaces, 1) + subTotal};
87     if (io.GetConnectionState().NeedAdvance(static_cast<std::size_t>(total)) &&
88         !io.AdvanceRecord()) {
89       return false;
90     }
91     leadingSpaces = 1;
92   }
93   return io.EmitRepeated(' ', leadingSpaces) &&
94       io.Emit(n < 0 ? "-" : "+", signChars) &&
95       io.EmitRepeated('0', leadingZeroes) && io.Emit(p, digits);
96 }
97 
98 // Formats the exponent (see table 13.1 for all the cases)
99 const char *RealOutputEditingBase::FormatExponent(
100     int expo, const DataEdit &edit, int &length) {
101   char *eEnd{&exponent_[sizeof exponent_]};
102   char *exponent{eEnd};
103   for (unsigned e{static_cast<unsigned>(std::abs(expo))}; e > 0;) {
104     unsigned quotient{e / 10u};
105     *--exponent = '0' + e - 10 * quotient;
106     e = quotient;
107   }
108   if (edit.expoDigits) {
109     if (int ed{*edit.expoDigits}) { // Ew.dEe with e > 0
110       while (exponent > exponent_ + 2 /*E+*/ && exponent + ed > eEnd) {
111         *--exponent = '0';
112       }
113     } else if (exponent == eEnd) {
114       *--exponent = '0'; // Ew.dE0 with zero-valued exponent
115     }
116   } else { // ensure at least two exponent digits
117     while (exponent + 2 > eEnd) {
118       *--exponent = '0';
119     }
120   }
121   *--exponent = expo < 0 ? '-' : '+';
122   if (edit.expoDigits || edit.IsListDirected() || exponent + 3 == eEnd) {
123     *--exponent = edit.descriptor == 'D' ? 'D' : 'E'; // not 'G'
124   }
125   length = eEnd - exponent;
126   return exponent;
127 }
128 
129 bool RealOutputEditingBase::EmitPrefix(
130     const DataEdit &edit, std::size_t length, std::size_t width) {
131   if (edit.IsListDirected()) {
132     int prefixLength{edit.descriptor == DataEdit::ListDirectedRealPart ? 2
133             : edit.descriptor == DataEdit::ListDirectedImaginaryPart   ? 0
134                                                                        : 1};
135     int suffixLength{edit.descriptor == DataEdit::ListDirectedRealPart ||
136                 edit.descriptor == DataEdit::ListDirectedImaginaryPart
137             ? 1
138             : 0};
139     length += prefixLength + suffixLength;
140     ConnectionState &connection{io_.GetConnectionState()};
141     return (!connection.NeedAdvance(length) || io_.AdvanceRecord()) &&
142         io_.Emit(" (", prefixLength);
143   } else if (width > length) {
144     return io_.EmitRepeated(' ', width - length);
145   } else {
146     return true;
147   }
148 }
149 
150 bool RealOutputEditingBase::EmitSuffix(const DataEdit &edit) {
151   if (edit.descriptor == DataEdit::ListDirectedRealPart) {
152     return io_.Emit(edit.modes.editingFlags & decimalComma ? ";" : ",", 1);
153   } else if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
154     return io_.Emit(")", 1);
155   } else {
156     return true;
157   }
158 }
159 
160 template <int binaryPrecision>
161 decimal::ConversionToDecimalResult RealOutputEditing<binaryPrecision>::Convert(
162     int significantDigits, enum decimal::FortranRounding rounding, int flags) {
163   auto converted{decimal::ConvertToDecimal<binaryPrecision>(buffer_,
164       sizeof buffer_, static_cast<enum decimal::DecimalConversionFlags>(flags),
165       significantDigits, rounding, x_)};
166   if (!converted.str) { // overflow
167     io_.GetIoErrorHandler().Crash(
168         "RealOutputEditing::Convert : buffer size %zd was insufficient",
169         sizeof buffer_);
170   }
171   return converted;
172 }
173 
174 // 13.7.2.3.3 in F'2018
175 template <int binaryPrecision>
176 bool RealOutputEditing<binaryPrecision>::EditEorDOutput(const DataEdit &edit) {
177   int editDigits{edit.digits.value_or(0)}; // 'd' field
178   int editWidth{edit.width.value_or(0)}; // 'w' field
179   int significantDigits{editDigits};
180   int flags{0};
181   if (edit.modes.editingFlags & signPlus) {
182     flags |= decimal::AlwaysSign;
183   }
184   if (editWidth == 0) { // "the processor selects the field width"
185     if (edit.digits.has_value()) { // E0.d
186       editWidth = editDigits + 6; // -.666E+ee
187     } else { // E0
188       flags |= decimal::Minimize;
189       significantDigits =
190           sizeof buffer_ - 5; // sign, NUL, + 3 extra for EN scaling
191     }
192   }
193   bool isEN{edit.variation == 'N'};
194   bool isES{edit.variation == 'S'};
195   int scale{isEN || isES ? 1 : edit.modes.scale}; // 'kP' value
196   int zeroesAfterPoint{0};
197   if (scale < 0) {
198     zeroesAfterPoint = -scale;
199     significantDigits = std::max(0, significantDigits - zeroesAfterPoint);
200   } else if (scale > 0) {
201     ++significantDigits;
202     scale = std::min(scale, significantDigits + 1);
203   }
204   // In EN editing, multiple attempts may be necessary, so it's in a loop.
205   while (true) {
206     decimal::ConversionToDecimalResult converted{
207         Convert(significantDigits, edit.modes.round, flags)};
208     if (IsInfOrNaN(converted)) {
209       return EmitPrefix(edit, converted.length, editWidth) &&
210           io_.Emit(converted.str, converted.length) && EmitSuffix(edit);
211     }
212     if (!IsZero()) {
213       converted.decimalExponent -= scale;
214     }
215     if (isEN && scale < 3 && (converted.decimalExponent % 3) != 0) {
216       // EN mode: boost the scale and significant digits, try again; need
217       // an effective exponent field that's a multiple of three.
218       ++scale;
219       ++significantDigits;
220       continue;
221     }
222     // Format the exponent (see table 13.1 for all the cases)
223     int expoLength{0};
224     const char *exponent{
225         FormatExponent(converted.decimalExponent, edit, expoLength)};
226     int signLength{*converted.str == '-' || *converted.str == '+' ? 1 : 0};
227     int convertedDigits{static_cast<int>(converted.length) - signLength};
228     int zeroesBeforePoint{std::max(0, scale - convertedDigits)};
229     int digitsBeforePoint{std::max(0, scale - zeroesBeforePoint)};
230     int digitsAfterPoint{convertedDigits - digitsBeforePoint};
231     int trailingZeroes{flags & decimal::Minimize
232             ? 0
233             : std::max(0,
234                   significantDigits - (convertedDigits + zeroesBeforePoint))};
235     int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
236         1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
237         expoLength};
238     int width{editWidth > 0 ? editWidth : totalLength};
239     if (totalLength > width) {
240       return io_.EmitRepeated('*', width);
241     }
242     if (totalLength < width && digitsBeforePoint == 0 &&
243         zeroesBeforePoint == 0) {
244       zeroesBeforePoint = 1;
245       ++totalLength;
246     }
247     return EmitPrefix(edit, totalLength, width) &&
248         io_.Emit(converted.str, signLength + digitsBeforePoint) &&
249         io_.EmitRepeated('0', zeroesBeforePoint) &&
250         io_.Emit(edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
251         io_.EmitRepeated('0', zeroesAfterPoint) &&
252         io_.Emit(
253             converted.str + signLength + digitsBeforePoint, digitsAfterPoint) &&
254         io_.EmitRepeated('0', trailingZeroes) &&
255         io_.Emit(exponent, expoLength) && EmitSuffix(edit);
256   }
257 }
258 
259 // 13.7.2.3.2 in F'2018
260 template <int binaryPrecision>
261 bool RealOutputEditing<binaryPrecision>::EditFOutput(const DataEdit &edit) {
262   int fracDigits{edit.digits.value_or(0)}; // 'd' field
263   const int editWidth{edit.width.value_or(0)}; // 'w' field
264   enum decimal::FortranRounding rounding{edit.modes.round};
265   int flags{0};
266   if (edit.modes.editingFlags & signPlus) {
267     flags |= decimal::AlwaysSign;
268   }
269   if (editWidth == 0) { // "the processor selects the field width"
270     if (!edit.digits.has_value()) { // F0
271       flags |= decimal::Minimize;
272       fracDigits = sizeof buffer_ - 2; // sign & NUL
273     }
274   }
275   // Multiple conversions may be needed to get the right number of
276   // effective rounded fractional digits.
277   int extraDigits{0};
278   bool canIncrease{true};
279   while (true) {
280     decimal::ConversionToDecimalResult converted{
281         Convert(extraDigits + fracDigits, rounding, flags)};
282     if (IsInfOrNaN(converted)) {
283       return EmitPrefix(edit, converted.length, editWidth) &&
284           io_.Emit(converted.str, converted.length) && EmitSuffix(edit);
285     }
286     int scale{IsZero() ? 1 : edit.modes.scale}; // kP
287     int expo{converted.decimalExponent + scale};
288     int signLength{*converted.str == '-' || *converted.str == '+' ? 1 : 0};
289     int convertedDigits{static_cast<int>(converted.length) - signLength};
290     int trailingOnes{0};
291     if (expo > extraDigits && extraDigits >= 0 && canIncrease) {
292       extraDigits = expo;
293       if (!edit.digits.has_value()) { // F0
294         fracDigits = sizeof buffer_ - extraDigits - 2; // sign & NUL
295       }
296       canIncrease = false; // only once
297       continue;
298     } else if (expo == -fracDigits && convertedDigits > 0) {
299       if (rounding != decimal::FortranRounding::RoundToZero) {
300         // Convert again without rounding so that we can round here
301         rounding = decimal::FortranRounding::RoundToZero;
302         continue;
303       } else if (converted.str[signLength] >= '5') {
304         // Value rounds up to a scaled 1 (e.g., 0.06 for F5.1 -> 0.1)
305         ++expo;
306         convertedDigits = 0;
307         trailingOnes = 1;
308       } else {
309         // Value rounds down to zero
310         expo = 0;
311         convertedDigits = 0;
312       }
313     } else if (expo < extraDigits && extraDigits > -fracDigits) {
314       extraDigits = std::max(expo, -fracDigits);
315       continue;
316     }
317     int digitsBeforePoint{std::max(0, std::min(expo, convertedDigits))};
318     int zeroesBeforePoint{std::max(0, expo - digitsBeforePoint)};
319     int zeroesAfterPoint{std::min(fracDigits, std::max(0, -expo))};
320     int digitsAfterPoint{convertedDigits - digitsBeforePoint};
321     int trailingZeroes{flags & decimal::Minimize
322             ? 0
323             : std::max(0,
324                   fracDigits -
325                       (zeroesAfterPoint + digitsAfterPoint + trailingOnes))};
326     if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint +
327             digitsAfterPoint + trailingOnes + trailingZeroes ==
328         0) {
329       zeroesBeforePoint = 1; // "." -> "0."
330     }
331     int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
332         1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingOnes +
333         trailingZeroes};
334     int width{editWidth > 0 ? editWidth : totalLength};
335     if (totalLength > width) {
336       return io_.EmitRepeated('*', width);
337     }
338     if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
339       zeroesBeforePoint = 1;
340       ++totalLength;
341     }
342     return EmitPrefix(edit, totalLength, width) &&
343         io_.Emit(converted.str, signLength + digitsBeforePoint) &&
344         io_.EmitRepeated('0', zeroesBeforePoint) &&
345         io_.Emit(edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
346         io_.EmitRepeated('0', zeroesAfterPoint) &&
347         io_.Emit(
348             converted.str + signLength + digitsBeforePoint, digitsAfterPoint) &&
349         io_.EmitRepeated('1', trailingOnes) &&
350         io_.EmitRepeated('0', trailingZeroes) &&
351         io_.EmitRepeated(' ', trailingBlanks_) && EmitSuffix(edit);
352   }
353 }
354 
355 // 13.7.5.2.3 in F'2018
356 template <int binaryPrecision>
357 DataEdit RealOutputEditing<binaryPrecision>::EditForGOutput(DataEdit edit) {
358   edit.descriptor = 'E';
359   int significantDigits{
360       edit.digits.value_or(BinaryFloatingPoint::decimalPrecision)}; // 'd'
361   if (!edit.width.has_value() || (*edit.width > 0 && significantDigits == 0)) {
362     return edit; // Gw.0 -> Ew.0 for w > 0
363   }
364   int flags{0};
365   if (edit.modes.editingFlags & signPlus) {
366     flags |= decimal::AlwaysSign;
367   }
368   decimal::ConversionToDecimalResult converted{
369       Convert(significantDigits, edit.modes.round, flags)};
370   if (IsInfOrNaN(converted)) {
371     return edit;
372   }
373   int expo{IsZero() ? 1 : converted.decimalExponent}; // 's'
374   if (expo < 0 || expo > significantDigits) {
375     return edit; // Ew.d
376   }
377   edit.descriptor = 'F';
378   edit.modes.scale = 0; // kP is ignored for G when no exponent field
379   trailingBlanks_ = 0;
380   int editWidth{edit.width.value_or(0)};
381   if (editWidth > 0) {
382     int expoDigits{edit.expoDigits.value_or(0)};
383     trailingBlanks_ = expoDigits > 0 ? expoDigits + 2 : 4; // 'n'
384     *edit.width = std::max(0, editWidth - trailingBlanks_);
385   }
386   if (edit.digits.has_value()) {
387     *edit.digits = std::max(0, *edit.digits - expo);
388   }
389   return edit;
390 }
391 
392 // 13.10.4 in F'2018
393 template <int binaryPrecision>
394 bool RealOutputEditing<binaryPrecision>::EditListDirectedOutput(
395     const DataEdit &edit) {
396   decimal::ConversionToDecimalResult converted{Convert(1, edit.modes.round)};
397   if (IsInfOrNaN(converted)) {
398     return EditEorDOutput(edit);
399   }
400   int expo{converted.decimalExponent};
401   if (expo < 0 || expo > BinaryFloatingPoint::decimalPrecision) {
402     DataEdit copy{edit};
403     copy.modes.scale = 1; // 1P
404     return EditEorDOutput(copy);
405   }
406   return EditFOutput(edit);
407 }
408 
409 // 13.7.5.2.6 in F'2018
410 template <int binaryPrecision>
411 bool RealOutputEditing<binaryPrecision>::EditEXOutput(const DataEdit &) {
412   io_.GetIoErrorHandler().Crash(
413       "EX output editing is not yet implemented"); // TODO
414 }
415 
416 template <int KIND> bool RealOutputEditing<KIND>::Edit(const DataEdit &edit) {
417   switch (edit.descriptor) {
418   case 'D':
419     return EditEorDOutput(edit);
420   case 'E':
421     if (edit.variation == 'X') {
422       return EditEXOutput(edit);
423     } else {
424       return EditEorDOutput(edit);
425     }
426   case 'F':
427     return EditFOutput(edit);
428   case 'B':
429   case 'O':
430   case 'Z':
431     return EditIntegerOutput<KIND>(io_, edit,
432         static_cast<common::HostSignedIntType<8 * KIND>>(
433             decimal::BinaryFloatingPointNumber<binaryPrecision>{x_}.raw()));
434   case 'G':
435     return Edit(EditForGOutput(edit));
436   case 'A': // legacy extension
437     return EditDefaultCharacterOutput(
438         io_, edit, reinterpret_cast<char *>(&x_), sizeof x_);
439   default:
440     if (edit.IsListDirected()) {
441       return EditListDirectedOutput(edit);
442     }
443     io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
444         "Data edit descriptor '%c' may not be used with a REAL data item",
445         edit.descriptor);
446     return false;
447   }
448   return false;
449 }
450 
451 bool ListDirectedLogicalOutput(IoStatementState &io,
452     ListDirectedStatementState<Direction::Output> &list, bool truth) {
453   return list.EmitLeadingSpaceOrAdvance(io) && io.Emit(truth ? "T" : "F", 1);
454 }
455 
456 bool EditLogicalOutput(IoStatementState &io, const DataEdit &edit, bool truth) {
457   switch (edit.descriptor) {
458   case 'L':
459   case 'G':
460     return io.EmitRepeated(' ', std::max(0, edit.width.value_or(1) - 1)) &&
461         io.Emit(truth ? "T" : "F", 1);
462   default:
463     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
464         "Data edit descriptor '%c' may not be used with a LOGICAL data item",
465         edit.descriptor);
466     return false;
467   }
468 }
469 
470 bool ListDirectedDefaultCharacterOutput(IoStatementState &io,
471     ListDirectedStatementState<Direction::Output> &list, const char *x,
472     std::size_t length) {
473   bool ok{true};
474   MutableModes &modes{io.mutableModes()};
475   ConnectionState &connection{io.GetConnectionState()};
476   if (modes.delim) {
477     ok = ok && list.EmitLeadingSpaceOrAdvance(io);
478     // Value is delimited with ' or " marks, and interior
479     // instances of that character are doubled.
480     ok = ok && io.Emit(&modes.delim, 1);
481     auto EmitOne{[&](char ch) {
482       if (connection.NeedAdvance(1)) {
483         ok = ok && io.AdvanceRecord();
484       }
485       ok = ok && io.Emit(&ch, 1);
486     }};
487     for (std::size_t j{0}; j < length; ++j) {
488       // Doubled delimiters must be put on the same record
489       // in order to be acceptable as list-directed or NAMELIST
490       // input; however, this requirement is not always possible
491       // when the records have a fixed length, as is the case with
492       // internal output.  The standard is silent on what should
493       // happen, and no two extant Fortran implementations do
494       // the same thing when tested with this case.
495       // This runtime splits the doubled delimiters across
496       // two records for lack of a better alternative.
497       if (x[j] == modes.delim) {
498         EmitOne(x[j]);
499       }
500       EmitOne(x[j]);
501     }
502     EmitOne(modes.delim);
503   } else {
504     // Undelimited list-directed output
505     ok = ok &&
506         list.EmitLeadingSpaceOrAdvance(
507             io, length > 0 && !list.lastWasUndelimitedCharacter());
508     std::size_t put{0};
509     while (ok && put < length) {
510       auto chunk{std::min(length - put, connection.RemainingSpaceInRecord())};
511       ok = ok && io.Emit(x + put, chunk);
512       put += chunk;
513       if (put < length) {
514         ok = ok && io.AdvanceRecord() && io.Emit(" ", 1);
515       }
516     }
517     list.set_lastWasUndelimitedCharacter(true);
518   }
519   return ok;
520 }
521 
522 bool EditDefaultCharacterOutput(IoStatementState &io, const DataEdit &edit,
523     const char *x, std::size_t length) {
524   switch (edit.descriptor) {
525   case 'A':
526   case 'G':
527     break;
528   default:
529     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
530         "Data edit descriptor '%c' may not be used with a CHARACTER data item",
531         edit.descriptor);
532     return false;
533   }
534   int len{static_cast<int>(length)};
535   int width{edit.width.value_or(len)};
536   return io.EmitRepeated(' ', std::max(0, width - len)) &&
537       io.Emit(x, std::min(width, len));
538 }
539 
540 template bool EditIntegerOutput<1>(
541     IoStatementState &, const DataEdit &, std::int8_t);
542 template bool EditIntegerOutput<2>(
543     IoStatementState &, const DataEdit &, std::int16_t);
544 template bool EditIntegerOutput<4>(
545     IoStatementState &, const DataEdit &, std::int32_t);
546 template bool EditIntegerOutput<8>(
547     IoStatementState &, const DataEdit &, std::int64_t);
548 template bool EditIntegerOutput<16>(
549     IoStatementState &, const DataEdit &, common::int128_t);
550 
551 template class RealOutputEditing<2>;
552 template class RealOutputEditing<3>;
553 template class RealOutputEditing<4>;
554 template class RealOutputEditing<8>;
555 template class RealOutputEditing<10>;
556 // TODO: double/double
557 template class RealOutputEditing<16>;
558 } // namespace Fortran::runtime::io
559