llvm-project
1134 строки · 37.0 Кб
1//===-- runtime/edit-input.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-input.h"
10#include "namelist.h"
11#include "utf.h"
12#include "flang/Common/optional.h"
13#include "flang/Common/real.h"
14#include "flang/Common/uint128.h"
15#include "flang/Runtime/freestanding-tools.h"
16#include <algorithm>
17#include <cfenv>
18
19namespace Fortran::runtime::io {
20RT_OFFLOAD_API_GROUP_BEGIN
21
22// Checks that a list-directed input value has been entirely consumed and
23// doesn't contain unparsed characters before the next value separator.
24static inline RT_API_ATTRS bool IsCharValueSeparator(
25const DataEdit &edit, char32_t ch) {
26char32_t comma{
27edit.modes.editingFlags & decimalComma ? char32_t{';'} : char32_t{','}};
28return ch == ' ' || ch == '\t' || ch == comma || ch == '/' ||
29(edit.IsNamelist() && (ch == '&' || ch == '$'));
30}
31
32static RT_API_ATTRS bool CheckCompleteListDirectedField(
33IoStatementState &io, const DataEdit &edit) {
34if (edit.IsListDirected()) {
35std::size_t byteCount;
36if (auto ch{io.GetCurrentChar(byteCount)}) {
37if (IsCharValueSeparator(edit, *ch)) {
38return true;
39} else {
40const auto &connection{io.GetConnectionState()};
41io.GetIoErrorHandler().SignalError(IostatBadListDirectedInputSeparator,
42"invalid character (0x%x) after list-directed input value, "
43"at column %d in record %d",
44static_cast<unsigned>(*ch),
45static_cast<int>(connection.positionInRecord + 1),
46static_cast<int>(connection.currentRecordNumber));
47return false;
48}
49} else {
50return true; // end of record: ok
51}
52} else {
53return true;
54}
55}
56
57template <int LOG2_BASE>
58static RT_API_ATTRS bool EditBOZInput(
59IoStatementState &io, const DataEdit &edit, void *n, std::size_t bytes) {
60// Skip leading white space & zeroes
61Fortran::common::optional<int> remaining{io.CueUpInput(edit)};
62auto start{io.GetConnectionState().positionInRecord};
63Fortran::common::optional<char32_t> next{io.NextInField(remaining, edit)};
64if (next.value_or('?') == '0') {
65do {
66start = io.GetConnectionState().positionInRecord;
67next = io.NextInField(remaining, edit);
68} while (next && *next == '0');
69}
70// Count significant digits after any leading white space & zeroes
71int digits{0};
72int significantBits{0};
73for (; next; next = io.NextInField(remaining, edit)) {
74char32_t ch{*next};
75if (ch == ' ' || ch == '\t') {
76if (edit.modes.editingFlags & blankZero) {
77ch = '0'; // BZ mode - treat blank as if it were zero
78} else {
79continue;
80}
81}
82if (ch >= '0' && ch <= '1') {
83} else if (LOG2_BASE >= 3 && ch >= '2' && ch <= '7') {
84} else if (LOG2_BASE >= 4 && ch >= '8' && ch <= '9') {
85} else if (LOG2_BASE >= 4 && ch >= 'A' && ch <= 'F') {
86} else if (LOG2_BASE >= 4 && ch >= 'a' && ch <= 'f') {
87} else if (ch == ',') {
88break; // end non-list-directed field early
89} else {
90io.GetIoErrorHandler().SignalError(
91"Bad character '%lc' in B/O/Z input field", ch);
92return false;
93}
94if (digits++ == 0) {
95significantBits = 4;
96if (ch >= '0' && ch <= '1') {
97significantBits = 1;
98} else if (ch >= '2' && ch <= '3') {
99significantBits = 2;
100} else if (ch >= '4' && ch <= '7') {
101significantBits = 3;
102} else {
103significantBits = 4;
104}
105} else {
106significantBits += LOG2_BASE;
107}
108}
109auto significantBytes{static_cast<std::size_t>(significantBits + 7) / 8};
110if (significantBytes > bytes) {
111io.GetIoErrorHandler().SignalError(IostatBOZInputOverflow,
112"B/O/Z input of %d digits overflows %zd-byte variable", digits, bytes);
113return false;
114}
115// Reset to start of significant digits
116io.HandleAbsolutePosition(start);
117remaining.reset();
118// Make a second pass now that the digit count is known
119std::memset(n, 0, bytes);
120int increment{isHostLittleEndian ? -1 : 1};
121auto *data{reinterpret_cast<unsigned char *>(n) +
122(isHostLittleEndian ? significantBytes - 1 : 0)};
123int shift{((digits - 1) * LOG2_BASE) & 7};
124while (digits > 0) {
125char32_t ch{*io.NextInField(remaining, edit)};
126int digit{0};
127if (ch == ' ' || ch == '\t') {
128if (edit.modes.editingFlags & blankZero) {
129ch = '0'; // BZ mode - treat blank as if it were zero
130} else {
131continue;
132}
133}
134--digits;
135if (ch >= '0' && ch <= '9') {
136digit = ch - '0';
137} else if (ch >= 'A' && ch <= 'F') {
138digit = ch + 10 - 'A';
139} else if (ch >= 'a' && ch <= 'f') {
140digit = ch + 10 - 'a';
141} else {
142continue;
143}
144if (shift < 0) {
145if (shift + LOG2_BASE > 0) { // misaligned octal
146*data |= digit >> -shift;
147}
148shift += 8;
149data += increment;
150}
151*data |= digit << shift;
152shift -= LOG2_BASE;
153}
154return CheckCompleteListDirectedField(io, edit);
155}
156
157static inline RT_API_ATTRS char32_t GetRadixPointChar(const DataEdit &edit) {
158return edit.modes.editingFlags & decimalComma ? char32_t{','} : char32_t{'.'};
159}
160
161// Prepares input from a field, and returns the sign, if any, else '\0'.
162static RT_API_ATTRS char ScanNumericPrefix(IoStatementState &io,
163const DataEdit &edit, Fortran::common::optional<char32_t> &next,
164Fortran::common::optional<int> &remaining) {
165remaining = io.CueUpInput(edit);
166next = io.NextInField(remaining, edit);
167char sign{'\0'};
168if (next) {
169if (*next == '-' || *next == '+') {
170sign = *next;
171if (!edit.IsListDirected()) {
172io.SkipSpaces(remaining);
173}
174next = io.NextInField(remaining, edit);
175}
176}
177return sign;
178}
179
180RT_API_ATTRS bool EditIntegerInput(
181IoStatementState &io, const DataEdit &edit, void *n, int kind) {
182RUNTIME_CHECK(io.GetIoErrorHandler(), kind >= 1 && !(kind & (kind - 1)));
183switch (edit.descriptor) {
184case DataEdit::ListDirected:
185if (IsNamelistNameOrSlash(io)) {
186return false;
187}
188break;
189case 'G':
190case 'I':
191break;
192case 'B':
193return EditBOZInput<1>(io, edit, n, kind);
194case 'O':
195return EditBOZInput<3>(io, edit, n, kind);
196case 'Z':
197return EditBOZInput<4>(io, edit, n, kind);
198case 'A': // legacy extension
199return EditCharacterInput(io, edit, reinterpret_cast<char *>(n), kind);
200default:
201io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
202"Data edit descriptor '%c' may not be used with an INTEGER data item",
203edit.descriptor);
204return false;
205}
206Fortran::common::optional<int> remaining;
207Fortran::common::optional<char32_t> next;
208char sign{ScanNumericPrefix(io, edit, next, remaining)};
209common::UnsignedInt128 value{0};
210bool any{!!sign};
211bool overflow{false};
212for (; next; next = io.NextInField(remaining, edit)) {
213char32_t ch{*next};
214if (ch == ' ' || ch == '\t') {
215if (edit.modes.editingFlags & blankZero) {
216ch = '0'; // BZ mode - treat blank as if it were zero
217} else {
218continue;
219}
220}
221int digit{0};
222if (ch >= '0' && ch <= '9') {
223digit = ch - '0';
224} else if (ch == ',') {
225break; // end non-list-directed field early
226} else {
227io.GetIoErrorHandler().SignalError(
228"Bad character '%lc' in INTEGER input field", ch);
229return false;
230}
231static constexpr auto maxu128{~common::UnsignedInt128{0}};
232static constexpr auto maxu128OverTen{maxu128 / 10};
233static constexpr int maxLastDigit{
234static_cast<int>(maxu128 - (maxu128OverTen * 10))};
235overflow |= value >= maxu128OverTen &&
236(value > maxu128OverTen || digit > maxLastDigit);
237value *= 10;
238value += digit;
239any = true;
240}
241if (!any && !remaining) {
242io.GetIoErrorHandler().SignalError(
243"Integer value absent from NAMELIST or list-directed input");
244return false;
245}
246auto maxForKind{common::UnsignedInt128{1} << ((8 * kind) - 1)};
247overflow |= value >= maxForKind && (value > maxForKind || sign != '-');
248if (overflow) {
249io.GetIoErrorHandler().SignalError(IostatIntegerInputOverflow,
250"Decimal input overflows INTEGER(%d) variable", kind);
251return false;
252}
253if (sign == '-') {
254value = -value;
255}
256if (any || !io.GetIoErrorHandler().InError()) {
257// The value is stored in the lower order bits on big endian platform.
258// When memcpy, shift the value to the higher order bit.
259auto shft{static_cast<int>(sizeof(value.low())) - kind};
260// For kind==8 (i.e. shft==0), the value is stored in low_ in big endian.
261if (!isHostLittleEndian && shft >= 0) {
262auto l{value.low() << (8 * shft)};
263std::memcpy(n, &l, kind);
264} else {
265std::memcpy(n, &value, kind); // a blank field means zero
266}
267return true;
268} else {
269return false;
270}
271}
272
273// Parses a REAL input number from the input source as a normalized
274// fraction into a supplied buffer -- there's an optional '-', a
275// decimal point when the input is not hexadecimal, and at least one
276// digit. Replaces blanks with zeroes where appropriate.
277struct ScannedRealInput {
278// Number of characters that (should) have been written to the
279// buffer -- this can be larger than the buffer size, which
280// indicates buffer overflow. Zero indicates an error.
281int got{0};
282int exponent{0}; // adjusted as necessary; binary if isHexadecimal
283bool isHexadecimal{false}; // 0X...
284};
285static RT_API_ATTRS ScannedRealInput ScanRealInput(
286char *buffer, int bufferSize, IoStatementState &io, const DataEdit &edit) {
287Fortran::common::optional<int> remaining;
288Fortran::common::optional<char32_t> next;
289int got{0};
290Fortran::common::optional<int> radixPointOffset;
291// The following lambda definition violates the conding style,
292// but cuda-11.8 nvcc hits an internal error with the brace initialization.
293auto Put = [&](char ch) -> void {
294if (got < bufferSize) {
295buffer[got] = ch;
296}
297++got;
298};
299char sign{ScanNumericPrefix(io, edit, next, remaining)};
300if (sign == '-') {
301Put('-');
302}
303bool bzMode{(edit.modes.editingFlags & blankZero) != 0};
304int exponent{0};
305if (!next || (!bzMode && *next == ' ') ||
306(!(edit.modes.editingFlags & decimalComma) && *next == ',')) {
307if (!edit.IsListDirected() && !io.GetConnectionState().IsAtEOF()) {
308// An empty/blank field means zero when not list-directed.
309// A fixed-width field containing only a sign is also zero;
310// this behavior isn't standard-conforming in F'2023 but it is
311// required to pass FCVS.
312Put('0');
313}
314return {got, exponent, false};
315}
316char32_t radixPointChar{GetRadixPointChar(edit)};
317char32_t first{*next >= 'a' && *next <= 'z' ? *next + 'A' - 'a' : *next};
318bool isHexadecimal{false};
319if (first == 'N' || first == 'I') {
320// NaN or infinity - convert to upper case
321// Subtle: a blank field of digits could be followed by 'E' or 'D',
322for (; next &&
323((*next >= 'a' && *next <= 'z') || (*next >= 'A' && *next <= 'Z'));
324next = io.NextInField(remaining, edit)) {
325if (*next >= 'a' && *next <= 'z') {
326Put(*next - 'a' + 'A');
327} else {
328Put(*next);
329}
330}
331if (next && *next == '(') { // NaN(...)
332Put('(');
333int depth{1};
334while (true) {
335next = io.NextInField(remaining, edit);
336if (depth == 0) {
337break;
338} else if (!next) {
339return {}; // error
340} else if (*next == '(') {
341++depth;
342} else if (*next == ')') {
343--depth;
344}
345Put(*next);
346}
347}
348} else if (first == radixPointChar || (first >= '0' && first <= '9') ||
349(bzMode && (first == ' ' || first == '\t')) || first == 'E' ||
350first == 'D' || first == 'Q') {
351if (first == '0') {
352next = io.NextInField(remaining, edit);
353if (next && (*next == 'x' || *next == 'X')) { // 0X...
354isHexadecimal = true;
355next = io.NextInField(remaining, edit);
356} else {
357Put('0');
358}
359}
360// input field is normalized to a fraction
361if (!isHexadecimal) {
362Put('.');
363}
364auto start{got};
365for (; next; next = io.NextInField(remaining, edit)) {
366char32_t ch{*next};
367if (ch == ' ' || ch == '\t') {
368if (isHexadecimal) {
369return {}; // error
370} else if (bzMode) {
371ch = '0'; // BZ mode - treat blank as if it were zero
372} else {
373continue; // ignore blank in fixed field
374}
375}
376if (ch == '0' && got == start && !radixPointOffset) {
377// omit leading zeroes before the radix point
378} else if (ch >= '0' && ch <= '9') {
379Put(ch);
380} else if (ch == radixPointChar && !radixPointOffset) {
381// The radix point character is *not* copied to the buffer.
382radixPointOffset = got - start; // # of digits before the radix point
383} else if (isHexadecimal && ch >= 'A' && ch <= 'F') {
384Put(ch);
385} else if (isHexadecimal && ch >= 'a' && ch <= 'f') {
386Put(ch - 'a' + 'A'); // normalize to capitals
387} else {
388break;
389}
390}
391if (got == start) {
392// Nothing but zeroes and maybe a radix point. F'2018 requires
393// at least one digit, but F'77 did not, and a bare "." shows up in
394// the FCVS suite.
395Put('0'); // emit at least one digit
396}
397// In list-directed input, a bad exponent is not consumed.
398auto nextBeforeExponent{next};
399auto startExponent{io.GetConnectionState().positionInRecord};
400bool hasGoodExponent{false};
401if (next) {
402if (isHexadecimal) {
403if (*next == 'p' || *next == 'P') {
404next = io.NextInField(remaining, edit);
405} else {
406// The binary exponent is not optional in the standard.
407return {}; // error
408}
409} else if (*next == 'e' || *next == 'E' || *next == 'd' || *next == 'D' ||
410*next == 'q' || *next == 'Q') {
411// Optional exponent letter. Blanks are allowed between the
412// optional exponent letter and the exponent value.
413io.SkipSpaces(remaining);
414next = io.NextInField(remaining, edit);
415}
416}
417if (next &&
418(*next == '-' || *next == '+' || (*next >= '0' && *next <= '9') ||
419*next == ' ' || *next == '\t')) {
420bool negExpo{*next == '-'};
421if (negExpo || *next == '+') {
422next = io.NextInField(remaining, edit);
423}
424for (; next; next = io.NextInField(remaining, edit)) {
425if (*next >= '0' && *next <= '9') {
426hasGoodExponent = true;
427if (exponent < 10000) {
428exponent = 10 * exponent + *next - '0';
429}
430} else if (*next == ' ' || *next == '\t') {
431if (isHexadecimal) {
432break;
433} else if (bzMode) {
434hasGoodExponent = true;
435exponent = 10 * exponent;
436}
437} else {
438break;
439}
440}
441if (negExpo) {
442exponent = -exponent;
443}
444}
445if (!hasGoodExponent) {
446if (isHexadecimal) {
447return {}; // error
448}
449// There isn't a good exponent; do not consume it.
450next = nextBeforeExponent;
451io.HandleAbsolutePosition(startExponent);
452// The default exponent is -kP, but the scale factor doesn't affect
453// an explicit exponent.
454exponent = -edit.modes.scale;
455}
456// Adjust exponent by number of digits before the radix point.
457if (isHexadecimal) {
458// Exponents for hexadecimal input are binary.
459exponent += radixPointOffset.value_or(got - start) * 4;
460} else if (radixPointOffset) {
461exponent += *radixPointOffset;
462} else {
463// When no redix point (or comma) appears in the value, the 'd'
464// part of the edit descriptor must be interpreted as the number of
465// digits in the value to be interpreted as being to the *right* of
466// the assumed radix point (13.7.2.3.2)
467exponent += got - start - edit.digits.value_or(0);
468}
469}
470// Consume the trailing ')' of a list-directed or NAMELIST complex
471// input value.
472if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
473if (next && (*next == ' ' || *next == '\t')) {
474io.SkipSpaces(remaining);
475next = io.NextInField(remaining, edit);
476}
477if (!next) { // NextInField fails on separators like ')'
478std::size_t byteCount{0};
479next = io.GetCurrentChar(byteCount);
480if (next && *next == ')') {
481io.HandleRelativePosition(byteCount);
482}
483}
484} else if (remaining) {
485while (next && (*next == ' ' || *next == '\t')) {
486next = io.NextInField(remaining, edit);
487}
488if (next && (*next != ',' || (edit.modes.editingFlags & decimalComma))) {
489return {}; // error: unused nonblank character in fixed-width field
490}
491}
492return {got, exponent, isHexadecimal};
493}
494
495static RT_API_ATTRS void RaiseFPExceptions(
496decimal::ConversionResultFlags flags) {
497#undef RAISE
498#if defined(RT_DEVICE_COMPILATION)
499Terminator terminator(__FILE__, __LINE__);
500#define RAISE(e) \
501terminator.Crash( \
502"not implemented yet: raising FP exception in device code: %s", #e);
503#else // !defined(RT_DEVICE_COMPILATION)
504#ifdef feraisexcept // a macro in some environments; omit std::
505#define RAISE feraiseexcept
506#else
507#define RAISE std::feraiseexcept
508#endif
509#endif // !defined(RT_DEVICE_COMPILATION)
510if (flags & decimal::ConversionResultFlags::Overflow) {
511RAISE(FE_OVERFLOW);
512}
513if (flags & decimal::ConversionResultFlags::Underflow) {
514RAISE(FE_UNDERFLOW);
515}
516if (flags & decimal::ConversionResultFlags::Inexact) {
517RAISE(FE_INEXACT);
518}
519if (flags & decimal::ConversionResultFlags::Invalid) {
520RAISE(FE_INVALID);
521}
522#undef RAISE
523}
524
525// If no special modes are in effect and the form of the input value
526// that's present in the input stream is acceptable to the decimal->binary
527// converter without modification, this fast path for real input
528// saves time by avoiding memory copies and reformatting of the exponent.
529template <int PRECISION>
530static RT_API_ATTRS bool TryFastPathRealDecimalInput(
531IoStatementState &io, const DataEdit &edit, void *n) {
532if (edit.modes.editingFlags & (blankZero | decimalComma)) {
533return false;
534}
535if (edit.modes.scale != 0) {
536return false;
537}
538const ConnectionState &connection{io.GetConnectionState()};
539if (connection.internalIoCharKind > 1) {
540return false; // reading non-default character
541}
542const char *str{nullptr};
543std::size_t got{io.GetNextInputBytes(str)};
544if (got == 0 || str == nullptr || !connection.recordLength.has_value()) {
545return false; // could not access reliably-terminated input stream
546}
547const char *p{str};
548std::int64_t maxConsume{
549std::min<std::int64_t>(got, edit.width.value_or(got))};
550const char *limit{str + maxConsume};
551decimal::ConversionToBinaryResult<PRECISION> converted{
552decimal::ConvertToBinary<PRECISION>(p, edit.modes.round, limit)};
553if (converted.flags & (decimal::Invalid | decimal::Overflow)) {
554return false;
555}
556if (edit.digits.value_or(0) != 0) {
557// Edit descriptor is Fw.d (or other) with d != 0, which
558// implies scaling
559const char *q{str};
560for (; q < limit; ++q) {
561if (*q == '.' || *q == 'n' || *q == 'N') {
562break;
563}
564}
565if (q == limit) {
566// No explicit decimal point, and not NaN/Inf.
567return false;
568}
569}
570if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
571// Need to consume a trailing ')', possibly with leading spaces
572for (; p < limit && (*p == ' ' || *p == '\t'); ++p) {
573}
574if (p < limit && *p == ')') {
575++p;
576} else {
577return false;
578}
579} else if (edit.IsListDirected()) {
580if (p < limit && !IsCharValueSeparator(edit, *p)) {
581return false;
582}
583} else {
584for (; p < limit && (*p == ' ' || *p == '\t'); ++p) {
585}
586if (edit.width && p < str + *edit.width) {
587return false; // unconverted characters remain in fixed width field
588}
589}
590// Success on the fast path!
591*reinterpret_cast<decimal::BinaryFloatingPointNumber<PRECISION> *>(n) =
592converted.binary;
593io.HandleRelativePosition(p - str);
594// Set FP exception flags
595if (converted.flags != decimal::ConversionResultFlags::Exact) {
596RaiseFPExceptions(converted.flags);
597}
598return true;
599}
600
601template <int binaryPrecision>
602RT_API_ATTRS decimal::ConversionToBinaryResult<binaryPrecision>
603ConvertHexadecimal(
604const char *&p, enum decimal::FortranRounding rounding, int expo) {
605using RealType = decimal::BinaryFloatingPointNumber<binaryPrecision>;
606using RawType = typename RealType::RawType;
607bool isNegative{*p == '-'};
608constexpr RawType one{1};
609RawType signBit{0};
610if (isNegative) {
611++p;
612signBit = one << (RealType::bits - 1);
613}
614RawType fraction{0};
615// Adjust the incoming binary P+/- exponent to shift the radix point
616// to below the LSB and add in the bias.
617expo += binaryPrecision - 1 + RealType::exponentBias;
618// Input the fraction.
619int roundingBit{0};
620int guardBit{0};
621for (; *p; ++p) {
622fraction <<= 4;
623expo -= 4;
624if (*p >= '0' && *p <= '9') {
625fraction |= *p - '0';
626} else if (*p >= 'A' && *p <= 'F') {
627fraction |= *p - 'A' + 10; // data were normalized to capitals
628} else {
629break;
630}
631if (fraction >> binaryPrecision) {
632while (fraction >> binaryPrecision) {
633guardBit |= roundingBit;
634roundingBit = (int)fraction & 1;
635fraction >>= 1;
636++expo;
637}
638// Consume excess digits
639while (*++p) {
640if (*p == '0') {
641} else if ((*p >= '1' && *p <= '9') || (*p >= 'A' && *p <= 'F')) {
642guardBit = 1;
643} else {
644break;
645}
646}
647break;
648}
649}
650if (fraction) {
651// Boost biased expo if too small
652while (expo < 1) {
653guardBit |= roundingBit;
654roundingBit = (int)fraction & 1;
655fraction >>= 1;
656++expo;
657}
658// Normalize
659while (expo > 1 && !(fraction >> (binaryPrecision - 1))) {
660fraction <<= 1;
661--expo;
662guardBit = roundingBit = 0;
663}
664}
665// Rounding
666bool increase{false};
667switch (rounding) {
668case decimal::RoundNearest: // RN & RP
669increase = roundingBit && (guardBit | ((int)fraction & 1));
670break;
671case decimal::RoundUp: // RU
672increase = !isNegative && (roundingBit | guardBit);
673break;
674case decimal::RoundDown: // RD
675increase = isNegative && (roundingBit | guardBit);
676break;
677case decimal::RoundToZero: // RZ
678break;
679case decimal::RoundCompatible: // RC
680increase = roundingBit != 0;
681break;
682}
683if (increase) {
684++fraction;
685if (fraction >> binaryPrecision) {
686fraction >>= 1;
687++expo;
688}
689}
690// Package & return result
691constexpr RawType significandMask{(one << RealType::significandBits) - 1};
692int flags{(roundingBit | guardBit) ? decimal::Inexact : decimal::Exact};
693if (!fraction) {
694expo = 0;
695} else if (expo == 1 && !(fraction >> (binaryPrecision - 1))) {
696expo = 0; // subnormal
697flags |= decimal::Underflow;
698} else if (expo >= RealType::maxExponent) {
699if (rounding == decimal::RoundToZero ||
700(rounding == decimal::RoundDown && !isNegative) ||
701(rounding == decimal::RoundUp && isNegative)) {
702expo = RealType::maxExponent - 1; // +/-HUGE()
703fraction = significandMask;
704} else {
705expo = RealType::maxExponent; // +/-Inf
706fraction = 0;
707flags |= decimal::Overflow;
708}
709} else {
710fraction &= significandMask; // remove explicit normalization unless x87
711}
712return decimal::ConversionToBinaryResult<binaryPrecision>{
713RealType{static_cast<RawType>(signBit |
714static_cast<RawType>(expo) << RealType::significandBits | fraction)},
715static_cast<decimal::ConversionResultFlags>(flags)};
716}
717
718template <int KIND>
719RT_API_ATTRS bool EditCommonRealInput(
720IoStatementState &io, const DataEdit &edit, void *n) {
721constexpr int binaryPrecision{common::PrecisionOfRealKind(KIND)};
722if (TryFastPathRealDecimalInput<binaryPrecision>(io, edit, n)) {
723return CheckCompleteListDirectedField(io, edit);
724}
725// Fast path wasn't available or didn't work; go the more general route
726static constexpr int maxDigits{
727common::MaxDecimalConversionDigits(binaryPrecision)};
728static constexpr int bufferSize{maxDigits + 18};
729char buffer[bufferSize];
730auto scanned{ScanRealInput(buffer, maxDigits + 2, io, edit)};
731int got{scanned.got};
732if (got >= maxDigits + 2) {
733io.GetIoErrorHandler().Crash("EditCommonRealInput: buffer was too small");
734return false;
735}
736if (got == 0) {
737const auto &connection{io.GetConnectionState()};
738io.GetIoErrorHandler().SignalError(IostatBadRealInput,
739"Bad real input data at column %d of record %d",
740static_cast<int>(connection.positionInRecord + 1),
741static_cast<int>(connection.currentRecordNumber));
742return false;
743}
744decimal::ConversionToBinaryResult<binaryPrecision> converted;
745const char *p{buffer};
746if (scanned.isHexadecimal) {
747buffer[got] = '\0';
748converted = ConvertHexadecimal<binaryPrecision>(
749p, edit.modes.round, scanned.exponent);
750} else {
751bool hadExtra{got > maxDigits};
752int exponent{scanned.exponent};
753if (exponent != 0) {
754buffer[got++] = 'e';
755if (exponent < 0) {
756buffer[got++] = '-';
757exponent = -exponent;
758}
759if (exponent > 9999) {
760exponent = 9999; // will convert to +/-Inf
761}
762if (exponent > 999) {
763int dig{exponent / 1000};
764buffer[got++] = '0' + dig;
765int rest{exponent - 1000 * dig};
766dig = rest / 100;
767buffer[got++] = '0' + dig;
768rest -= 100 * dig;
769dig = rest / 10;
770buffer[got++] = '0' + dig;
771buffer[got++] = '0' + (rest - 10 * dig);
772} else if (exponent > 99) {
773int dig{exponent / 100};
774buffer[got++] = '0' + dig;
775int rest{exponent - 100 * dig};
776dig = rest / 10;
777buffer[got++] = '0' + dig;
778buffer[got++] = '0' + (rest - 10 * dig);
779} else if (exponent > 9) {
780int dig{exponent / 10};
781buffer[got++] = '0' + dig;
782buffer[got++] = '0' + (exponent - 10 * dig);
783} else {
784buffer[got++] = '0' + exponent;
785}
786}
787buffer[got] = '\0';
788converted = decimal::ConvertToBinary<binaryPrecision>(p, edit.modes.round);
789if (hadExtra) {
790converted.flags = static_cast<enum decimal::ConversionResultFlags>(
791converted.flags | decimal::Inexact);
792}
793}
794if (*p) { // unprocessed junk after value
795const auto &connection{io.GetConnectionState()};
796io.GetIoErrorHandler().SignalError(IostatBadRealInput,
797"Trailing characters after real input data at column %d of record %d",
798static_cast<int>(connection.positionInRecord + 1),
799static_cast<int>(connection.currentRecordNumber));
800return false;
801}
802*reinterpret_cast<decimal::BinaryFloatingPointNumber<binaryPrecision> *>(n) =
803converted.binary;
804// Set FP exception flags
805if (converted.flags != decimal::ConversionResultFlags::Exact) {
806if (converted.flags & decimal::ConversionResultFlags::Overflow) {
807io.GetIoErrorHandler().SignalError(IostatRealInputOverflow);
808return false;
809}
810RaiseFPExceptions(converted.flags);
811}
812return CheckCompleteListDirectedField(io, edit);
813}
814
815template <int KIND>
816RT_API_ATTRS bool EditRealInput(
817IoStatementState &io, const DataEdit &edit, void *n) {
818switch (edit.descriptor) {
819case DataEdit::ListDirected:
820if (IsNamelistNameOrSlash(io)) {
821return false;
822}
823return EditCommonRealInput<KIND>(io, edit, n);
824case DataEdit::ListDirectedRealPart:
825case DataEdit::ListDirectedImaginaryPart:
826case 'F':
827case 'E': // incl. EN, ES, & EX
828case 'D':
829case 'G':
830return EditCommonRealInput<KIND>(io, edit, n);
831case 'B':
832return EditBOZInput<1>(io, edit, n,
833common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
834case 'O':
835return EditBOZInput<3>(io, edit, n,
836common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
837case 'Z':
838return EditBOZInput<4>(io, edit, n,
839common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3);
840case 'A': // legacy extension
841return EditCharacterInput(io, edit, reinterpret_cast<char *>(n), KIND);
842default:
843io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
844"Data edit descriptor '%c' may not be used for REAL input",
845edit.descriptor);
846return false;
847}
848}
849
850// 13.7.3 in Fortran 2018
851RT_API_ATTRS bool EditLogicalInput(
852IoStatementState &io, const DataEdit &edit, bool &x) {
853switch (edit.descriptor) {
854case DataEdit::ListDirected:
855if (IsNamelistNameOrSlash(io)) {
856return false;
857}
858break;
859case 'L':
860case 'G':
861break;
862default:
863io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
864"Data edit descriptor '%c' may not be used for LOGICAL input",
865edit.descriptor);
866return false;
867}
868Fortran::common::optional<int> remaining{io.CueUpInput(edit)};
869Fortran::common::optional<char32_t> next{io.NextInField(remaining, edit)};
870if (next && *next == '.') { // skip optional period
871next = io.NextInField(remaining, edit);
872}
873if (!next) {
874io.GetIoErrorHandler().SignalError("Empty LOGICAL input field");
875return false;
876}
877switch (*next) {
878case 'T':
879case 't':
880x = true;
881break;
882case 'F':
883case 'f':
884x = false;
885break;
886default:
887io.GetIoErrorHandler().SignalError(
888"Bad character '%lc' in LOGICAL input field", *next);
889return false;
890}
891if (remaining) { // ignore the rest of a fixed-width field
892io.HandleRelativePosition(*remaining);
893} else if (edit.descriptor == DataEdit::ListDirected) {
894while (io.NextInField(remaining, edit)) { // discard rest of field
895}
896}
897return CheckCompleteListDirectedField(io, edit);
898}
899
900// See 13.10.3.1 paragraphs 7-9 in Fortran 2018
901template <typename CHAR>
902static RT_API_ATTRS bool EditDelimitedCharacterInput(
903IoStatementState &io, CHAR *x, std::size_t length, char32_t delimiter) {
904bool result{true};
905while (true) {
906std::size_t byteCount{0};
907auto ch{io.GetCurrentChar(byteCount)};
908if (!ch) {
909if (io.AdvanceRecord()) {
910continue;
911} else {
912result = false; // EOF in character value
913break;
914}
915}
916io.HandleRelativePosition(byteCount);
917if (*ch == delimiter) {
918auto next{io.GetCurrentChar(byteCount)};
919if (next && *next == delimiter) {
920// Repeated delimiter: use as character value
921io.HandleRelativePosition(byteCount);
922} else {
923break; // closing delimiter
924}
925}
926if (length > 0) {
927*x++ = *ch;
928--length;
929}
930}
931Fortran::runtime::fill_n(x, length, ' ');
932return result;
933}
934
935template <typename CHAR>
936static RT_API_ATTRS bool EditListDirectedCharacterInput(
937IoStatementState &io, CHAR *x, std::size_t length, const DataEdit &edit) {
938std::size_t byteCount{0};
939auto ch{io.GetCurrentChar(byteCount)};
940if (ch && (*ch == '\'' || *ch == '"')) {
941io.HandleRelativePosition(byteCount);
942return EditDelimitedCharacterInput(io, x, length, *ch);
943}
944if (IsNamelistNameOrSlash(io) || io.GetConnectionState().IsAtEOF()) {
945return false;
946}
947// Undelimited list-directed character input: stop at a value separator
948// or the end of the current record. Subtlety: the "remaining" count
949// here is a dummy that's used to avoid the interpretation of separators
950// in NextInField.
951Fortran::common::optional<int> remaining{length > 0 ? maxUTF8Bytes : 0};
952while (Fortran::common::optional<char32_t> next{
953io.NextInField(remaining, edit)}) {
954bool isSep{false};
955switch (*next) {
956case ' ':
957case '\t':
958case '/':
959isSep = true;
960break;
961case '&':
962case '$':
963isSep = edit.IsNamelist();
964break;
965case ',':
966isSep = !(edit.modes.editingFlags & decimalComma);
967break;
968case ';':
969isSep = !!(edit.modes.editingFlags & decimalComma);
970break;
971default:
972break;
973}
974if (isSep) {
975remaining = 0;
976} else {
977*x++ = *next;
978remaining = --length > 0 ? maxUTF8Bytes : 0;
979}
980}
981Fortran::runtime::fill_n(x, length, ' ');
982return true;
983}
984
985template <typename CHAR>
986RT_API_ATTRS bool EditCharacterInput(IoStatementState &io, const DataEdit &edit,
987CHAR *x, std::size_t lengthChars) {
988switch (edit.descriptor) {
989case DataEdit::ListDirected:
990return EditListDirectedCharacterInput(io, x, lengthChars, edit);
991case 'A':
992case 'G':
993break;
994case 'B':
995return EditBOZInput<1>(io, edit, x, lengthChars * sizeof *x);
996case 'O':
997return EditBOZInput<3>(io, edit, x, lengthChars * sizeof *x);
998case 'Z':
999return EditBOZInput<4>(io, edit, x, lengthChars * sizeof *x);
1000default:
1001io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
1002"Data edit descriptor '%c' may not be used with a CHARACTER data item",
1003edit.descriptor);
1004return false;
1005}
1006const ConnectionState &connection{io.GetConnectionState()};
1007std::size_t remainingChars{lengthChars};
1008// Skip leading characters.
1009// Their bytes don't count towards INQUIRE(IOLENGTH=).
1010std::size_t skipChars{0};
1011if (edit.width && *edit.width > 0) {
1012remainingChars = *edit.width;
1013if (remainingChars > lengthChars) {
1014skipChars = remainingChars - lengthChars;
1015}
1016}
1017// When the field is wider than the variable, we drop the leading
1018// characters. When the variable is wider than the field, there can be
1019// trailing padding or an EOR condition.
1020const char *input{nullptr};
1021std::size_t readyBytes{0};
1022// Transfer payload bytes; these do count.
1023while (remainingChars > 0) {
1024if (readyBytes == 0) {
1025readyBytes = io.GetNextInputBytes(input);
1026if (readyBytes == 0 ||
1027(readyBytes < remainingChars && edit.modes.nonAdvancing)) {
1028if (io.CheckForEndOfRecord(readyBytes)) {
1029if (readyBytes == 0) {
1030// PAD='YES' and no more data
1031Fortran::runtime::fill_n(x, lengthChars, ' ');
1032return !io.GetIoErrorHandler().InError();
1033} else {
1034// Do partial read(s) then pad on last iteration
1035}
1036} else {
1037return !io.GetIoErrorHandler().InError();
1038}
1039}
1040}
1041std::size_t chunkBytes;
1042std::size_t chunkChars{1};
1043bool skipping{skipChars > 0};
1044if (connection.isUTF8) {
1045chunkBytes = MeasureUTF8Bytes(*input);
1046if (skipping) {
1047--skipChars;
1048} else if (auto ucs{DecodeUTF8(input)}) {
1049if ((sizeof *x == 1 && *ucs > 0xff) ||
1050(sizeof *x == 2 && *ucs > 0xffff)) {
1051*x++ = '?';
1052} else {
1053*x++ = *ucs;
1054}
1055--lengthChars;
1056} else if (chunkBytes == 0) {
1057// error recovery: skip bad encoding
1058chunkBytes = 1;
1059}
1060} else if (connection.internalIoCharKind > 1) {
1061// Reading from non-default character internal unit
1062chunkBytes = connection.internalIoCharKind;
1063if (skipping) {
1064--skipChars;
1065} else {
1066char32_t buffer{0};
1067std::memcpy(&buffer, input, chunkBytes);
1068if ((sizeof *x == 1 && buffer > 0xff) ||
1069(sizeof *x == 2 && buffer > 0xffff)) {
1070*x++ = '?';
1071} else {
1072*x++ = buffer;
1073}
1074--lengthChars;
1075}
1076} else if constexpr (sizeof *x > 1) {
1077// Read single byte with expansion into multi-byte CHARACTER
1078chunkBytes = 1;
1079if (skipping) {
1080--skipChars;
1081} else {
1082*x++ = static_cast<unsigned char>(*input);
1083--lengthChars;
1084}
1085} else { // single bytes -> default CHARACTER
1086if (skipping) {
1087chunkBytes = std::min<std::size_t>(skipChars, readyBytes);
1088chunkChars = chunkBytes;
1089skipChars -= chunkChars;
1090} else {
1091chunkBytes = std::min<std::size_t>(remainingChars, readyBytes);
1092chunkBytes = std::min<std::size_t>(lengthChars, chunkBytes);
1093chunkChars = chunkBytes;
1094std::memcpy(x, input, chunkBytes);
1095x += chunkBytes;
1096lengthChars -= chunkChars;
1097}
1098}
1099input += chunkBytes;
1100remainingChars -= chunkChars;
1101if (!skipping) {
1102io.GotChar(chunkBytes);
1103}
1104io.HandleRelativePosition(chunkBytes);
1105readyBytes -= chunkBytes;
1106}
1107// Pad the remainder of the input variable, if any.
1108Fortran::runtime::fill_n(x, lengthChars, ' ');
1109return CheckCompleteListDirectedField(io, edit);
1110}
1111
1112template RT_API_ATTRS bool EditRealInput<2>(
1113IoStatementState &, const DataEdit &, void *);
1114template RT_API_ATTRS bool EditRealInput<3>(
1115IoStatementState &, const DataEdit &, void *);
1116template RT_API_ATTRS bool EditRealInput<4>(
1117IoStatementState &, const DataEdit &, void *);
1118template RT_API_ATTRS bool EditRealInput<8>(
1119IoStatementState &, const DataEdit &, void *);
1120template RT_API_ATTRS bool EditRealInput<10>(
1121IoStatementState &, const DataEdit &, void *);
1122// TODO: double/double
1123template RT_API_ATTRS bool EditRealInput<16>(
1124IoStatementState &, const DataEdit &, void *);
1125
1126template RT_API_ATTRS bool EditCharacterInput(
1127IoStatementState &, const DataEdit &, char *, std::size_t);
1128template RT_API_ATTRS bool EditCharacterInput(
1129IoStatementState &, const DataEdit &, char16_t *, std::size_t);
1130template RT_API_ATTRS bool EditCharacterInput(
1131IoStatementState &, const DataEdit &, char32_t *, std::size_t);
1132
1133RT_OFFLOAD_API_GROUP_END
1134} // namespace Fortran::runtime::io
1135