flang/runtime/format.h

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