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-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_