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).
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 
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.
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 
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.
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     for (; next; next = io.NextInField(remaining)) {
184       char32_t ch{*next};
185       if (ch == ' ' || ch == '\t') {
186         if (edit.modes.editingFlags & blankZero) {
187           ch = '0'; // BZ mode - treat blank as if it were zero
188         } else {
189           continue;
190         }
191       }
192       if (ch == '0' && got == start && !decimalPoint) {
193         // omit leading zeroes before the decimal
194       } else if (ch >= '0' && ch <= '9') {
195         Put(ch);
196       } else if (ch == decimal && !decimalPoint) {
197         // the decimal point is *not* copied to the buffer
198         decimalPoint = got - start; // # of digits before the decimal point
199       } else {
200         break;
201       }
202     }
203     if (got == start) {
204       Put('0'); // emit at least one digit
205     }
206     if (next &&
207         (*next == 'e' || *next == 'E' || *next == 'd' || *next == 'D' ||
208             *next == 'q' || *next == 'Q')) {
209       io.SkipSpaces(remaining);
210       next = io.NextInField(remaining);
211     }
212     exponent = -edit.modes.scale; // default exponent is -kP
213     if (next &&
214         (*next == '-' || *next == '+' || (*next >= '0' && *next <= '9'))) {
215       bool negExpo{*next == '-'};
216       if (negExpo || *next == '+') {
217         next = io.NextInField(remaining);
218       }
219       for (exponent = 0; next && (*next >= '0' && *next <= '9');
220            next = io.NextInField(remaining)) {
221         exponent = 10 * exponent + *next - '0';
222       }
223       if (negExpo) {
224         exponent = -exponent;
225       }
226     }
227     if (decimalPoint) {
228       exponent += *decimalPoint;
229     } else {
230       // When no decimal point (or comma) appears in the value, the 'd'
231       // part of the edit descriptor must be interpreted as the number of
232       // digits in the value to be interpreted as being to the *right* of
233       // the assumed decimal point (13.7.2.3.2)
234       exponent += got - start - edit.digits.value_or(0);
235     }
236   } else {
237     // TODO: hex FP input
238     exponent = 0;
239     return 0;
240   }
241   if (remaining) {
242     while (next && (*next == ' ' || *next == '\t')) {
243       next = io.NextInField(remaining);
244     }
245     if (next) {
246       return 0; // error: unused nonblank character in fixed-width field
247     }
248   }
249   return got;
250 }
251 
252 template <int binaryPrecision>
253 bool EditCommonRealInput(IoStatementState &io, const DataEdit &edit, void *n) {
254   static constexpr int maxDigits{
255       common::MaxDecimalConversionDigits(binaryPrecision)};
256   static constexpr int bufferSize{maxDigits + 18};
257   char buffer[bufferSize];
258   int exponent{0};
259   int got{ScanRealInput(buffer, maxDigits + 2, io, edit, exponent)};
260   if (got >= maxDigits + 2) {
261     io.GetIoErrorHandler().Crash("EditCommonRealInput: buffer was too small");
262     return false;
263   }
264   if (got == 0) {
265     io.GetIoErrorHandler().SignalError("Bad REAL input value");
266     return false;
267   }
268   bool hadExtra{got > maxDigits};
269   if (exponent != 0) {
270     got += std::snprintf(&buffer[got], bufferSize - got, "e%d", exponent);
271   }
272   buffer[got] = '\0';
273   const char *p{buffer};
274   decimal::ConversionToBinaryResult<binaryPrecision> converted{
275       decimal::ConvertToBinary<binaryPrecision>(p, edit.modes.round)};
276   if (hadExtra) {
277     converted.flags = static_cast<enum decimal::ConversionResultFlags>(
278         converted.flags | decimal::Inexact);
279   }
280   // TODO: raise converted.flags as exceptions?
281   *reinterpret_cast<decimal::BinaryFloatingPointNumber<binaryPrecision> *>(n) =
282       converted.binary;
283   return true;
284 }
285 
286 template <int binaryPrecision>
287 bool EditRealInput(IoStatementState &io, const DataEdit &edit, void *n) {
288   switch (edit.descriptor) {
289   case DataEdit::ListDirected:
290   case DataEdit::ListDirectedRealPart:
291   case DataEdit::ListDirectedImaginaryPart:
292   case 'F':
293   case 'E': // incl. EN, ES, & EX
294   case 'D':
295   case 'G':
296     return EditCommonRealInput<binaryPrecision>(io, edit, n);
297   case 'B':
298     return EditBOZInput(
299         io, edit, n, 2, common::BitsForBinaryPrecision(binaryPrecision));
300   case 'O':
301     return EditBOZInput(
302         io, edit, n, 8, common::BitsForBinaryPrecision(binaryPrecision));
303   case 'Z':
304     return EditBOZInput(
305         io, edit, n, 16, common::BitsForBinaryPrecision(binaryPrecision));
306   default:
307     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
308         "Data edit descriptor '%c' may not be used for REAL input",
309         edit.descriptor);
310     return false;
311   }
312 }
313 
314 // 13.7.3 in Fortran 2018
315 bool EditLogicalInput(IoStatementState &io, const DataEdit &edit, bool &x) {
316   switch (edit.descriptor) {
317   case DataEdit::ListDirected:
318   case 'L':
319   case 'G':
320     break;
321   default:
322     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
323         "Data edit descriptor '%c' may not be used for LOGICAL input",
324         edit.descriptor);
325     return false;
326   }
327   std::optional<int> remaining;
328   std::optional<char32_t> next{PrepareInput(io, edit, remaining)};
329   if (next && *next == '.') { // skip optional period
330     next = io.NextInField(remaining);
331   }
332   if (!next) {
333     io.GetIoErrorHandler().SignalError("Empty LOGICAL input field");
334     return false;
335   }
336   switch (*next) {
337   case 'T':
338   case 't':
339     x = true;
340     break;
341   case 'F':
342   case 'f':
343     x = false;
344     break;
345   default:
346     io.GetIoErrorHandler().SignalError(
347         "Bad character '%lc' in LOGICAL input field", *next);
348     return false;
349   }
350   if (remaining) { // ignore the rest of the field
351     io.HandleRelativePosition(*remaining);
352   } else if (edit.descriptor == DataEdit::ListDirected) {
353     while (io.NextInField(remaining)) { // discard rest of field
354     }
355   }
356   return true;
357 }
358 
359 // See 13.10.3.1 paragraphs 7-9 in Fortran 2018
360 static bool EditDelimitedCharacterInput(
361     IoStatementState &io, char *x, std::size_t length, char32_t delimiter) {
362   while (true) {
363     if (auto ch{io.GetCurrentChar()}) {
364       io.HandleRelativePosition(1);
365       if (*ch == delimiter) {
366         ch = io.GetCurrentChar();
367         if (ch && *ch == delimiter) {
368           // Repeated delimiter: use as character value.  Can't straddle a
369           // record boundary.
370           io.HandleRelativePosition(1);
371         } else {
372           std::fill_n(x, length, ' ');
373           return true;
374         }
375       }
376       if (length > 0) {
377         *x++ = *ch;
378         --length;
379       }
380     } else if (!io.AdvanceRecord()) { // EOF
381       std::fill_n(x, length, ' ');
382       return false;
383     }
384   }
385 }
386 
387 static bool EditListDirectedDefaultCharacterInput(
388     IoStatementState &io, char *x, std::size_t length) {
389   auto ch{io.GetCurrentChar()};
390   if (ch && (*ch == '\'' || *ch == '"')) {
391     io.HandleRelativePosition(1);
392     return EditDelimitedCharacterInput(io, x, length, *ch);
393   }
394   // Undelimited list-directed character input: stop at a value separator
395   // or the end of the current record.
396   std::optional<int> remaining{length};
397   for (std::optional<char32_t> next{io.NextInField(remaining)}; next;
398        next = io.NextInField(remaining)) {
399     switch (*next) {
400     case ' ':
401     case '\t':
402     case ',':
403     case ';':
404     case '/':
405       remaining = 0; // value separator: stop
406       break;
407     default:
408       *x++ = *next;
409       --length;
410     }
411   }
412   std::fill_n(x, length, ' ');
413   return true;
414 }
415 
416 bool EditDefaultCharacterInput(
417     IoStatementState &io, const DataEdit &edit, char *x, std::size_t length) {
418   switch (edit.descriptor) {
419   case DataEdit::ListDirected:
420     return EditListDirectedDefaultCharacterInput(io, x, length);
421   case 'A':
422   case 'G':
423     break;
424   default:
425     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
426         "Data edit descriptor '%c' may not be used with a CHARACTER data item",
427         edit.descriptor);
428     return false;
429   }
430   std::optional<int> remaining{length};
431   if (edit.width && *edit.width > 0) {
432     remaining = *edit.width;
433   }
434   // When the field is wider than the variable, we drop the leading
435   // characters.  When the variable is wider than the field, there's
436   // trailing padding.
437   std::int64_t skip{*remaining - static_cast<std::int64_t>(length)};
438   for (std::optional<char32_t> next{io.NextInField(remaining)}; next;
439        next = io.NextInField(remaining)) {
440     if (skip > 0) {
441       --skip;
442     } else {
443       *x++ = *next;
444       --length;
445     }
446   }
447   std::fill_n(x, length, ' ');
448   return true;
449 }
450 
451 template bool EditRealInput<8>(IoStatementState &, const DataEdit &, void *);
452 template bool EditRealInput<11>(IoStatementState &, const DataEdit &, void *);
453 template bool EditRealInput<24>(IoStatementState &, const DataEdit &, void *);
454 template bool EditRealInput<53>(IoStatementState &, const DataEdit &, void *);
455 template bool EditRealInput<64>(IoStatementState &, const DataEdit &, void *);
456 template bool EditRealInput<113>(IoStatementState &, const DataEdit &, void *);
457 } // namespace Fortran::runtime::io
458