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