1//===-- runtime/format.h ----------------------------------------*- 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// FORMAT string processing
10
11#ifndef FORTRAN_RUNTIME_FORMAT_H_
12#define FORTRAN_RUNTIME_FORMAT_H_
13
14#include "environment.h"
15#include "io-error.h"
16#include "flang/Common/Fortran.h"
17#include "flang/Common/optional.h"
18#include "flang/Decimal/decimal.h"
19#include "flang/Runtime/freestanding-tools.h"
20#include <cinttypes>
21
22namespace Fortran::runtime {
23class Descriptor;
24} // namespace Fortran::runtime
25
26namespace Fortran::runtime::io {
27
28class IoStatementState;
29
30enum EditingFlags {
31 blankZero = 1, // BLANK=ZERO or BZ edit
32 decimalComma = 2, // DECIMAL=COMMA or DC edit
33 signPlus = 4, // SIGN=PLUS or SP edit
34};
35
36struct MutableModes {
37 std::uint8_t editingFlags{0}; // BN, DP, SS
38 enum decimal::FortranRounding round{
39 executionEnvironment
40 .defaultOutputRoundingMode}; // RP/ROUND='PROCESSOR_DEFAULT'
41 bool pad{true}; // PAD= mode on READ
42 char delim{'\0'}; // DELIM=
43 short scale{0}; // kP
44 bool inNamelist{false}; // skip ! comments
45 bool nonAdvancing{false}; // ADVANCE='NO', or $ or \ in FORMAT
46};
47
48// A single edit descriptor extracted from a FORMAT
49struct DataEdit {
50 char descriptor; // capitalized: one of A, I, B, O, Z, F, E(N/S/X), D, G
51
52 // Special internal data edit descriptors for list-directed & NAMELIST I/O
53 RT_OFFLOAD_VAR_GROUP_BEGIN
54 static constexpr char ListDirected{'g'}; // non-COMPLEX list-directed
55 static constexpr char ListDirectedRealPart{'r'}; // emit "(r," or "(r;"
56 static constexpr char ListDirectedImaginaryPart{'z'}; // emit "z)"
57 static constexpr char ListDirectedNullValue{'n'}; // see 13.10.3.2
58 static constexpr char DefinedDerivedType{'d'}; // DT defined I/O
59 RT_OFFLOAD_VAR_GROUP_END
60 constexpr RT_API_ATTRS bool IsListDirected() const {
61 return descriptor == ListDirected || descriptor == ListDirectedRealPart ||
62 descriptor == ListDirectedImaginaryPart;
63 }
64 constexpr RT_API_ATTRS bool IsNamelist() const {
65 return IsListDirected() && modes.inNamelist;
66 }
67
68 char variation{'\0'}; // N, S, or X for EN, ES, EX; G/l for original G/list
69 Fortran::common::optional<int> width; // the 'w' field; optional for A
70 Fortran::common::optional<int> digits; // the 'm' or 'd' field
71 Fortran::common::optional<int> expoDigits; // 'Ee' field
72 MutableModes modes;
73 int repeat{1};
74
75 // "iotype" &/or "v_list" values for a DT'iotype'(v_list)
76 // defined I/O data edit descriptor
77 RT_OFFLOAD_VAR_GROUP_BEGIN
78 static constexpr std::size_t maxIoTypeChars{32};
79 static constexpr std::size_t maxVListEntries{4};
80 RT_OFFLOAD_VAR_GROUP_END
81 std::uint8_t ioTypeChars{0};
82 std::uint8_t vListEntries{0};
83 char ioType[maxIoTypeChars];
84 int vList[maxVListEntries];
85};
86
87// Generates a sequence of DataEdits from a FORMAT statement or
88// default-CHARACTER string. Driven by I/O item list processing.
89// Errors are fatal. See subclause 13.4 in Fortran 2018 for background.
90template <typename CONTEXT> class FormatControl {
91public:
92 using Context = CONTEXT;
93 using CharType = char; // formats are always default kind CHARACTER
94
95 RT_API_ATTRS FormatControl() {}
96 RT_API_ATTRS FormatControl(const Terminator &, const CharType *format,
97 std::size_t formatLength, const Descriptor *formatDescriptor = nullptr,
98 int maxHeight = maxMaxHeight);
99
100 // For attempting to allocate in a user-supplied stack area
101 static RT_API_ATTRS std::size_t GetNeededSize(int maxHeight) {
102 return sizeof(FormatControl) -
103 sizeof(Iteration) * (maxMaxHeight - maxHeight);
104 }
105
106 // Extracts the next data edit descriptor, handling control edit descriptors
107 // along the way. If maxRepeat==0, this is a peek at the next data edit
108 // descriptor.
109 RT_API_ATTRS Fortran::common::optional<DataEdit> GetNextDataEdit(
110 Context &, int maxRepeat = 1);
111
112 // Emit any remaining character literals after the last data item (on output)
113 // and perform remaining record positioning actions.
114 RT_API_ATTRS void Finish(Context &);
115
116private:
117 RT_OFFLOAD_VAR_GROUP_BEGIN
118 static constexpr std::uint8_t maxMaxHeight{100};
119
120 struct Iteration {
121 static constexpr int unlimited{-1};
122 int start{0}; // offset in format_ of '(' or a repeated edit descriptor
123 int remaining{0}; // while >0, decrement and iterate
124 };
125 RT_OFFLOAD_VAR_GROUP_END
126
127 RT_API_ATTRS void SkipBlanks() {
128 while (offset_ < formatLength_ &&
129 (format_[offset_] == ' ' || format_[offset_] == '\t' ||
130 format_[offset_] == '\v')) {
131 ++offset_;
132 }
133 }
134 RT_API_ATTRS CharType PeekNext() {
135 SkipBlanks();
136 return offset_ < formatLength_ ? format_[offset_] : '\0';
137 }
138 RT_API_ATTRS CharType GetNextChar(IoErrorHandler &handler) {
139 SkipBlanks();
140 if (offset_ >= formatLength_) {
141 if (formatLength_ == 0) {
142 handler.SignalError(
143 IostatErrorInFormat, "Empty or badly assigned FORMAT");
144 } else {
145 handler.SignalError(
146 IostatErrorInFormat, "FORMAT missing at least one ')'");
147 }
148 return '\n';
149 }
150 return format_[offset_++];
151 }
152 RT_API_ATTRS int GetIntField(
153 IoErrorHandler &, CharType firstCh = '\0', bool *hadError = nullptr);
154
155 // Advances through the FORMAT until the next data edit
156 // descriptor has been found; handles control edit descriptors
157 // along the way. Returns the repeat count that appeared
158 // before the descriptor (defaulting to 1) and leaves offset_
159 // pointing to the data edit.
160 RT_API_ATTRS int CueUpNextDataEdit(Context &, bool stop = false);
161
162 static constexpr RT_API_ATTRS CharType Capitalize(CharType ch) {
163 return ch >= 'a' && ch <= 'z' ? ch + 'A' - 'a' : ch;
164 }
165
166 RT_API_ATTRS void ReportBadFormat(
167 Context &context, const char *msg, int offset) const {
168 if constexpr (std::is_same_v<CharType, char>) {
169 // Echo the bad format in the error message, but trim any leading or
170 // trailing spaces.
171 int firstNonBlank{0};
172 while (firstNonBlank < formatLength_ && format_[firstNonBlank] == ' ') {
173 ++firstNonBlank;
174 }
175 int lastNonBlank{formatLength_ - 1};
176 while (lastNonBlank > firstNonBlank && format_[lastNonBlank] == ' ') {
177 --lastNonBlank;
178 }
179 if (firstNonBlank <= lastNonBlank) {
180 context.SignalError(IostatErrorInFormat,
181 "%s; at offset %d in format '%.*s'", msg, offset,
182 lastNonBlank - firstNonBlank + 1, format_ + firstNonBlank);
183 return;
184 }
185 }
186 context.SignalError(IostatErrorInFormat, "%s; at offset %d", msg, offset);
187 }
188
189 // Data members are arranged and typed so as to reduce size.
190 // This structure may be allocated in stack space loaned by the
191 // user program for internal I/O.
192 const std::uint8_t maxHeight_{maxMaxHeight};
193 std::uint8_t height_{0};
194 bool freeFormat_{false};
195 bool hitEnd_{false};
196 const CharType *format_{nullptr};
197 int formatLength_{0}; // in units of characters
198 int offset_{0}; // next item is at format_[offset_]
199
200 // must be last, may be incomplete
201 Iteration stack_[maxMaxHeight];
202};
203} // namespace Fortran::runtime::io
204#endif // FORTRAN_RUNTIME_FORMAT_H_
205

source code of flang/runtime/format.h