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