1 //===-- runtime/edit-input.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-input.h"
10 #include "flang/Common/real.h"
11 #include "flang/Common/uint128.h"
12 #include <algorithm>
13 
14 namespace Fortran::runtime::io {
15 
16 // For fixed-width fields, initialize the number of remaining characters.
17 // Skip over leading blanks, then return the first non-blank character (if any).
PrepareInput(IoStatementState & io,const DataEdit & edit,std::optional<int> & remaining)18 static std::optional<char32_t> PrepareInput(
19     IoStatementState &io, const DataEdit &edit, std::optional<int> &remaining) {
20   remaining.reset();
21   if (edit.descriptor == DataEdit::ListDirected) {
22     io.GetNextNonBlank();
23   } else {
24     if (edit.width.value_or(0) > 0) {
25       remaining = *edit.width;
26     }
27     io.SkipSpaces(remaining);
28   }
29   return io.NextInField(remaining);
30 }
31 
EditBOZInput(IoStatementState & io,const DataEdit & edit,void * n,int base,int totalBitSize)32 static bool EditBOZInput(IoStatementState &io, const DataEdit &edit, void *n,
33     int base, int totalBitSize) {
34   std::optional<int> remaining;
35   std::optional<char32_t> next{PrepareInput(io, edit, remaining)};
36   common::UnsignedInt128 value{0};
37   for (; next; next = io.NextInField(remaining)) {
38     char32_t ch{*next};
39     if (ch == ' ' || ch == '\t') {
40       continue;
41     }
42     int digit{0};
43     if (ch >= '0' && ch <= '1') {
44       digit = ch - '0';
45     } else if (base >= 8 && ch >= '2' && ch <= '7') {
46       digit = ch - '0';
47     } else if (base >= 10 && ch >= '8' && ch <= '9') {
48       digit = ch - '0';
49     } else if (base == 16 && ch >= 'A' && ch <= 'Z') {
50       digit = ch + 10 - 'A';
51     } else if (base == 16 && ch >= 'a' && ch <= 'z') {
52       digit = ch + 10 - 'a';
53     } else {
54       io.GetIoErrorHandler().SignalError(
55           "Bad character '%lc' in B/O/Z input field", ch);
56       return false;
57     }
58     value *= base;
59     value += digit;
60   }
61   // TODO: check for overflow
62   std::memcpy(n, &value, totalBitSize >> 3);
63   return true;
64 }
65 
66 // Prepares input from a field, and consumes the sign, if any.
67 // Returns true if there's a '-' sign.
ScanNumericPrefix(IoStatementState & io,const DataEdit & edit,std::optional<char32_t> & next,std::optional<int> & remaining)68 static bool ScanNumericPrefix(IoStatementState &io, const DataEdit &edit,
69     std::optional<char32_t> &next, std::optional<int> &remaining) {
70   next = PrepareInput(io, edit, remaining);
71   bool negative{false};
72   if (next) {
73     negative = *next == '-';
74     if (negative || *next == '+') {
75       io.SkipSpaces(remaining);
76       next = io.NextInField(remaining);
77     }
78   }
79   return negative;
80 }
81 
EditIntegerInput(IoStatementState & io,const DataEdit & edit,void * n,int kind)82 bool EditIntegerInput(
83     IoStatementState &io, const DataEdit &edit, void *n, int kind) {
84   RUNTIME_CHECK(io.GetIoErrorHandler(), kind >= 1 && !(kind & (kind - 1)));
85   switch (edit.descriptor) {
86   case DataEdit::ListDirected:
87   case 'G':
88   case 'I':
89     break;
90   case 'B':
91     return EditBOZInput(io, edit, n, 2, kind << 3);
92   case 'O':
93     return EditBOZInput(io, edit, n, 8, kind << 3);
94   case 'Z':
95     return EditBOZInput(io, edit, n, 16, kind << 3);
96   default:
97     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
98         "Data edit descriptor '%c' may not be used with an INTEGER data item",
99         edit.descriptor);
100     return false;
101   }
102   std::optional<int> remaining;
103   std::optional<char32_t> next;
104   bool negate{ScanNumericPrefix(io, edit, next, remaining)};
105   common::UnsignedInt128 value;
106   for (; next; next = io.NextInField(remaining)) {
107     char32_t ch{*next};
108     if (ch == ' ' || ch == '\t') {
109       if (edit.modes.editingFlags & blankZero) {
110         ch = '0'; // BZ mode - treat blank as if it were zero
111       } else {
112         continue;
113       }
114     }
115     int digit{0};
116     if (ch >= '0' && ch <= '9') {
117       digit = ch - '0';
118     } else {
119       io.GetIoErrorHandler().SignalError(
120           "Bad character '%lc' in INTEGER input field", ch);
121       return false;
122     }
123     value *= 10;
124     value += digit;
125   }
126   if (negate) {
127     value = -value;
128   }
129   std::memcpy(n, &value, kind);
130   return true;
131 }
132 
133 // Parses a REAL input number from the input source as a normalized
134 // fraction into a supplied buffer -- there's an optional '-', a
135 // decimal point, and at least one digit.  The adjusted exponent value
136 // is returned in a reference argument.  The returned value is the number
137 // of characters that (should) have been written to the buffer -- this can
138 // be larger than the buffer size and can indicate overflow.  Replaces
139 // blanks with zeroes if appropriate.
ScanRealInput(char * buffer,int bufferSize,IoStatementState & io,const DataEdit & edit,int & exponent)140 static int ScanRealInput(char *buffer, int bufferSize, IoStatementState &io,
141     const DataEdit &edit, int &exponent) {
142   std::optional<int> remaining;
143   std::optional<char32_t> next;
144   int got{0};
145   std::optional<int> decimalPoint;
146   auto Put{[&](char ch) -> void {
147     if (got < bufferSize) {
148       buffer[got] = ch;
149     }
150     ++got;
151   }};
152   if (ScanNumericPrefix(io, edit, next, remaining)) {
153     Put('-');
154   }
155   if (!next) { // empty field means zero
156     Put('0');
157     return got;
158   }
159   char32_t decimal = edit.modes.editingFlags & decimalComma ? ',' : '.';
160   char32_t first{*next >= 'a' && *next <= 'z' ? *next + 'A' - 'a' : *next};
161   if (first == 'N' || first == 'I') {
162     // NaN or infinity - convert to upper case
163     // Subtle: a blank field of digits could be followed by 'E' or 'D',
164     for (; next &&
165          ((*next >= 'a' && *next <= 'z') || (*next >= 'A' && *next <= 'Z'));
166          next = io.NextInField(remaining)) {
167       if (*next >= 'a' && *next <= 'z') {
168         Put(*next - 'a' + 'A');
169       } else {
170         Put(*next);
171       }
172     }
173     if (next && *next == '(') { // NaN(...)
174       while (next && *next != ')') {
175         next = io.NextInField(remaining);
176       }
177     }
178     exponent = 0;
179   } else if (first == decimal || (first >= '0' && first <= '9') ||
180       first == 'E' || first == 'D' || first == 'Q') {
181     Put('.'); // input field is normalized to a fraction
182     auto start{got};
183     bool bzMode{(edit.modes.editingFlags & blankZero) != 0};
184     for (; next; next = io.NextInField(remaining)) {
185       char32_t ch{*next};
186       if (ch == ' ' || ch == '\t') {
187         if (bzMode) {
188           ch = '0'; // BZ mode - treat blank as if it were zero
189         } else {
190           continue;
191         }
192       }
193       if (ch == '0' && got == start && !decimalPoint) {
194         // omit leading zeroes before the decimal
195       } else if (ch >= '0' && ch <= '9') {
196         Put(ch);
197       } else if (ch == decimal && !decimalPoint) {
198         // the decimal point is *not* copied to the buffer
199         decimalPoint = got - start; // # of digits before the decimal point
200       } else {
201         break;
202       }
203     }
204     if (got == start) {
205       Put('0'); // emit at least one digit
206     }
207     if (next &&
208         (*next == 'e' || *next == 'E' || *next == 'd' || *next == 'D' ||
209             *next == 'q' || *next == 'Q')) {
210       // Optional exponent letter.  Blanks are allowed between the
211       // optional exponent letter and the exponent value.
212       io.SkipSpaces(remaining);
213       next = io.NextInField(remaining);
214     }
215     // The default exponent is -kP, but the scale factor doesn't affect
216     // an explicit exponent.
217     exponent = -edit.modes.scale;
218     if (next &&
219         (*next == '-' || *next == '+' || (*next >= '0' && *next <= '9') ||
220             (bzMode && (*next == ' ' || *next == '\t')))) {
221       bool negExpo{*next == '-'};
222       if (negExpo || *next == '+') {
223         next = io.NextInField(remaining);
224       }
225       for (exponent = 0; next; next = io.NextInField(remaining)) {
226         if (*next >= '0' && *next <= '9') {
227           exponent = 10 * exponent + *next - '0';
228         } else if (bzMode && (*next == ' ' || *next == '\t')) {
229           exponent = 10 * exponent;
230         } else {
231           break;
232         }
233       }
234       if (negExpo) {
235         exponent = -exponent;
236       }
237     }
238     if (decimalPoint) {
239       exponent += *decimalPoint;
240     } else {
241       // When no decimal point (or comma) appears in the value, the 'd'
242       // part of the edit descriptor must be interpreted as the number of
243       // digits in the value to be interpreted as being to the *right* of
244       // the assumed decimal point (13.7.2.3.2)
245       exponent += got - start - edit.digits.value_or(0);
246     }
247   } else {
248     // TODO: hex FP input
249     exponent = 0;
250     return 0;
251   }
252   if (remaining) {
253     while (next && (*next == ' ' || *next == '\t')) {
254       next = io.NextInField(remaining);
255     }
256     if (next) {
257       return 0; // error: unused nonblank character in fixed-width field
258     }
259   }
260   return got;
261 }
262 
263 template <int KIND>
EditCommonRealInput(IoStatementState & io,const DataEdit & edit,void * n)264 bool EditCommonRealInput(IoStatementState &io, const DataEdit &edit, void *n) {
265   constexpr int binaryPrecision{common::PrecisionOfRealKind(KIND)};
266   static constexpr int maxDigits{
267       common::MaxDecimalConversionDigits(binaryPrecision)};
268   static constexpr int bufferSize{maxDigits + 18};
269   char buffer[bufferSize];
270   int exponent{0};
271   int got{ScanRealInput(buffer, maxDigits + 2, io, edit, exponent)};
272   if (got >= maxDigits + 2) {
273     io.GetIoErrorHandler().Crash("EditCommonRealInput: buffer was too small");
274     return false;
275   }
276   if (got == 0) {
277     io.GetIoErrorHandler().SignalError("Bad REAL input value");
278     return false;
279   }
280   bool hadExtra{got > maxDigits};
281   if (exponent != 0) {
282     got += std::snprintf(&buffer[got], bufferSize - got, "e%d", exponent);
283   }
284   buffer[got] = '\0';
285   const char *p{buffer};
286   decimal::ConversionToBinaryResult<binaryPrecision> converted{
287       decimal::ConvertToBinary<binaryPrecision>(p, edit.modes.round)};
288   if (hadExtra) {
289     converted.flags = static_cast<enum decimal::ConversionResultFlags>(
290         converted.flags | decimal::Inexact);
291   }
292   // TODO: raise converted.flags as exceptions?
293   *reinterpret_cast<decimal::BinaryFloatingPointNumber<binaryPrecision> *>(n) =
294       converted.binary;
295   return true;
296 }
297 
298 template <int KIND>
EditRealInput(IoStatementState & io,const DataEdit & edit,void * n)299 bool EditRealInput(IoStatementState &io, const DataEdit &edit, void *n) {
300   constexpr int binaryPrecision{common::PrecisionOfRealKind(KIND)};
301   switch (edit.descriptor) {
302   case DataEdit::ListDirected:
303   case DataEdit::ListDirectedRealPart:
304   case DataEdit::ListDirectedImaginaryPart:
305   case 'F':
306   case 'E': // incl. EN, ES, & EX
307   case 'D':
308   case 'G':
309     return EditCommonRealInput<KIND>(io, edit, n);
310   case 'B':
311     return EditBOZInput(
312         io, edit, n, 2, common::BitsForBinaryPrecision(binaryPrecision));
313   case 'O':
314     return EditBOZInput(
315         io, edit, n, 8, common::BitsForBinaryPrecision(binaryPrecision));
316   case 'Z':
317     return EditBOZInput(
318         io, edit, n, 16, common::BitsForBinaryPrecision(binaryPrecision));
319   default:
320     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
321         "Data edit descriptor '%c' may not be used for REAL input",
322         edit.descriptor);
323     return false;
324   }
325 }
326 
327 // 13.7.3 in Fortran 2018
EditLogicalInput(IoStatementState & io,const DataEdit & edit,bool & x)328 bool EditLogicalInput(IoStatementState &io, const DataEdit &edit, bool &x) {
329   switch (edit.descriptor) {
330   case DataEdit::ListDirected:
331   case 'L':
332   case 'G':
333     break;
334   default:
335     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
336         "Data edit descriptor '%c' may not be used for LOGICAL input",
337         edit.descriptor);
338     return false;
339   }
340   std::optional<int> remaining;
341   std::optional<char32_t> next{PrepareInput(io, edit, remaining)};
342   if (next && *next == '.') { // skip optional period
343     next = io.NextInField(remaining);
344   }
345   if (!next) {
346     io.GetIoErrorHandler().SignalError("Empty LOGICAL input field");
347     return false;
348   }
349   switch (*next) {
350   case 'T':
351   case 't':
352     x = true;
353     break;
354   case 'F':
355   case 'f':
356     x = false;
357     break;
358   default:
359     io.GetIoErrorHandler().SignalError(
360         "Bad character '%lc' in LOGICAL input field", *next);
361     return false;
362   }
363   if (remaining) { // ignore the rest of the field
364     io.HandleRelativePosition(*remaining);
365   } else if (edit.descriptor == DataEdit::ListDirected) {
366     while (io.NextInField(remaining)) { // discard rest of field
367     }
368   }
369   return true;
370 }
371 
372 // See 13.10.3.1 paragraphs 7-9 in Fortran 2018
EditDelimitedCharacterInput(IoStatementState & io,char * x,std::size_t length,char32_t delimiter)373 static bool EditDelimitedCharacterInput(
374     IoStatementState &io, char *x, std::size_t length, char32_t delimiter) {
375   while (true) {
376     if (auto ch{io.GetCurrentChar()}) {
377       io.HandleRelativePosition(1);
378       if (*ch == delimiter) {
379         ch = io.GetCurrentChar();
380         if (ch && *ch == delimiter) {
381           // Repeated delimiter: use as character value.  Can't straddle a
382           // record boundary.
383           io.HandleRelativePosition(1);
384         } else {
385           std::fill_n(x, length, ' ');
386           return true;
387         }
388       }
389       if (length > 0) {
390         *x++ = *ch;
391         --length;
392       }
393     } else if (!io.AdvanceRecord()) { // EOF
394       std::fill_n(x, length, ' ');
395       return false;
396     }
397   }
398 }
399 
EditListDirectedDefaultCharacterInput(IoStatementState & io,char * x,std::size_t length)400 static bool EditListDirectedDefaultCharacterInput(
401     IoStatementState &io, char *x, std::size_t length) {
402   auto ch{io.GetCurrentChar()};
403   if (ch && (*ch == '\'' || *ch == '"')) {
404     io.HandleRelativePosition(1);
405     return EditDelimitedCharacterInput(io, x, length, *ch);
406   }
407   // Undelimited list-directed character input: stop at a value separator
408   // or the end of the current record.
409   std::optional<int> remaining{length};
410   for (std::optional<char32_t> next{io.NextInField(remaining)}; next;
411        next = io.NextInField(remaining)) {
412     switch (*next) {
413     case ' ':
414     case '\t':
415     case ',':
416     case ';':
417     case '/':
418       remaining = 0; // value separator: stop
419       break;
420     default:
421       *x++ = *next;
422       --length;
423     }
424   }
425   std::fill_n(x, length, ' ');
426   return true;
427 }
428 
EditDefaultCharacterInput(IoStatementState & io,const DataEdit & edit,char * x,std::size_t length)429 bool EditDefaultCharacterInput(
430     IoStatementState &io, const DataEdit &edit, char *x, std::size_t length) {
431   switch (edit.descriptor) {
432   case DataEdit::ListDirected:
433     return EditListDirectedDefaultCharacterInput(io, x, length);
434   case 'A':
435   case 'G':
436     break;
437   default:
438     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
439         "Data edit descriptor '%c' may not be used with a CHARACTER data item",
440         edit.descriptor);
441     return false;
442   }
443   std::optional<int> remaining{length};
444   if (edit.width && *edit.width > 0) {
445     remaining = *edit.width;
446   }
447   // When the field is wider than the variable, we drop the leading
448   // characters.  When the variable is wider than the field, there's
449   // trailing padding.
450   std::int64_t skip{*remaining - static_cast<std::int64_t>(length)};
451   for (std::optional<char32_t> next{io.NextInField(remaining)}; next;
452        next = io.NextInField(remaining)) {
453     if (skip > 0) {
454       --skip;
455     } else {
456       *x++ = *next;
457       --length;
458     }
459   }
460   std::fill_n(x, length, ' ');
461   return true;
462 }
463 
464 template bool EditRealInput<2>(IoStatementState &, const DataEdit &, void *);
465 template bool EditRealInput<3>(IoStatementState &, const DataEdit &, void *);
466 template bool EditRealInput<4>(IoStatementState &, const DataEdit &, void *);
467 template bool EditRealInput<8>(IoStatementState &, const DataEdit &, void *);
468 template bool EditRealInput<10>(IoStatementState &, const DataEdit &, void *);
469 // TODO: double/double
470 template bool EditRealInput<16>(IoStatementState &, const DataEdit &, void *);
471 } // namespace Fortran::runtime::io
472