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-consts.h" 17 #include "flang/Common/optional.h" 18 #include "flang/Decimal/decimal.h" 19 #include "flang/Runtime/freestanding-tools.h" 20 #include <cinttypes> 21 22 namespace Fortran::runtime { 23 class Descriptor; 24 } // namespace Fortran::runtime 25 26 namespace Fortran::runtime::io { 27 28 class IoStatementState; 29 30 enum 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 36 struct 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 49 struct 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. 90 template <typename CONTEXT> class FormatControl { 91 public: 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 116 private: 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