flang/runtime/descriptor-io.h

   1 //===-- runtime/descriptor-io.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 #ifndef FORTRAN_RUNTIME_DESCRIPTOR_IO_H_
  10 #define FORTRAN_RUNTIME_DESCRIPTOR_IO_H_
  11
  12 // Implementation of I/O data list item transfers based on descriptors.
  13 // (All I/O items come through here so that the code is exercised for test;
  14 // some scalar I/O data transfer APIs could be changed to bypass their use
  15 // of descriptors in the future for better efficiency.)
  16
  17 #include "edit-input.h"
  18 #include "edit-output.h"
  19 #include "io-stmt.h"
  20 #include "terminator.h"
  21 #include "type-info.h"
  22 #include "unit.h"
  23 #include "flang/Common/uint128.h"
  24 #include "flang/Runtime/cpp-type.h"
  25 #include "flang/Runtime/descriptor.h"
  26
  27 namespace Fortran::runtime::io::descr {
  28 template <typename A>
  29 inline A &ExtractElement(IoStatementState &io, const Descriptor &descriptor,
  30     const SubscriptValue subscripts[]) {
  31   A *p{descriptor.Element<A>(subscripts)};
  32   if (!p) {
  33     io.GetIoErrorHandler().Crash("Bad address for I/O item -- null base "
  34                                  "address or subscripts out of range");
  35   }
  36   return *p;
  37 }
  38
  39 // Per-category descriptor-based I/O templates
  40
  41 // TODO (perhaps as a nontrivial but small starter project): implement
  42 // automatic repetition counts, like "10*3.14159", for list-directed and
  43 // NAMELIST array output.
  44
  45 template <int KIND, Direction DIR>
  46 inline bool FormattedIntegerIO(
  47     IoStatementState &io, const Descriptor &descriptor) {
  48   std::size_t numElements{descriptor.Elements()};
  49   SubscriptValue subscripts[maxRank];
  50   descriptor.GetLowerBounds(subscripts);
  51   using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
  52   bool anyInput{false};
  53   for (std::size_t j{0}; j < numElements; ++j) {
  54     if (auto edit{io.GetNextDataEdit()}) {
  55       IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
  56       if constexpr (DIR == Direction::Output) {
  57         if (!EditIntegerOutput<KIND>(io, *edit, x)) {
  58           return false;
  59         }
  60       } else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
  61         if (EditIntegerInput(io, *edit, reinterpret_cast<void *>(&x), KIND)) {
  62           anyInput = true;
  63         } else {
  64           return anyInput && edit->IsNamelist();
  65         }
  66       }
  67       if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
  68         io.GetIoErrorHandler().Crash(
  69             "FormattedIntegerIO: subscripts out of bounds");
  70       }
  71     } else {
  72       return false;
  73     }
  74   }
  75   return true;
  76 }
  77
  78 template <int KIND, Direction DIR>
  79 inline bool FormattedRealIO(
  80     IoStatementState &io, const Descriptor &descriptor) {
  81   std::size_t numElements{descriptor.Elements()};
  82   SubscriptValue subscripts[maxRank];
  83   descriptor.GetLowerBounds(subscripts);
  84   using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
  85   bool anyInput{false};
  86   for (std::size_t j{0}; j < numElements; ++j) {
  87     if (auto edit{io.GetNextDataEdit()}) {
  88       RawType &x{ExtractElement<RawType>(io, descriptor, subscripts)};
  89       if constexpr (DIR == Direction::Output) {
  90         if (!RealOutputEditing<KIND>{io, x}.Edit(*edit)) {
  91           return false;
  92         }
  93       } else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
  94         if (EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) {
  95           anyInput = true;
  96         } else {
  97           return anyInput && edit->IsNamelist();
  98         }
  99       }
 100       if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
 101         io.GetIoErrorHandler().Crash(
 102             "FormattedRealIO: subscripts out of bounds");
 103       }
 104     } else {
 105       return false;
 106     }
 107   }
 108   return true;
 109 }
 110
 111 template <int KIND, Direction DIR>
 112 inline bool FormattedComplexIO(
 113     IoStatementState &io, const Descriptor &descriptor) {
 114   std::size_t numElements{descriptor.Elements()};
 115   SubscriptValue subscripts[maxRank];
 116   descriptor.GetLowerBounds(subscripts);
 117   bool isListOutput{
 118       io.get_if<ListDirectedStatementState<Direction::Output>>() != nullptr};
 119   using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
 120   bool anyInput{false};
 121   for (std::size_t j{0}; j < numElements; ++j) {
 122     RawType *x{&ExtractElement<RawType>(io, descriptor, subscripts)};
 123     if (isListOutput) {
 124       DataEdit rEdit, iEdit;
 125       rEdit.descriptor = DataEdit::ListDirectedRealPart;
 126       iEdit.descriptor = DataEdit::ListDirectedImaginaryPart;
 127       rEdit.modes = iEdit.modes = io.mutableModes();
 128       if (!RealOutputEditing<KIND>{io, x[0]}.Edit(rEdit) ||
 129           !RealOutputEditing<KIND>{io, x[1]}.Edit(iEdit)) {
 130         return false;
 131       }
 132     } else {
 133       for (int k{0}; k < 2; ++k, ++x) {
 134         auto edit{io.GetNextDataEdit()};
 135         if (!edit) {
 136           return false;
 137         } else if constexpr (DIR == Direction::Output) {
 138           if (!RealOutputEditing<KIND>{io, *x}.Edit(*edit)) {
 139             return false;
 140           }
 141         } else if (edit->descriptor == DataEdit::ListDirectedNullValue) {
 142           break;
 143         } else if (EditRealInput<KIND>(
 144                        io, *edit, reinterpret_cast<void *>(x))) {
 145           anyInput = true;
 146         } else {
 147           return anyInput && edit->IsNamelist();
 148         }
 149       }
 150     }
 151     if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
 152       io.GetIoErrorHandler().Crash(
 153           "FormattedComplexIO: subscripts out of bounds");
 154     }
 155   }
 156   return true;
 157 }
 158
 159 template <typename A, Direction DIR>
 160 inline bool FormattedCharacterIO(
 161     IoStatementState &io, const Descriptor &descriptor) {
 162   std::size_t numElements{descriptor.Elements()};
 163   SubscriptValue subscripts[maxRank];
 164   descriptor.GetLowerBounds(subscripts);
 165   std::size_t length{descriptor.ElementBytes() / sizeof(A)};
 166   auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
 167   bool anyInput{false};
 168   for (std::size_t j{0}; j < numElements; ++j) {
 169     A *x{&ExtractElement<A>(io, descriptor, subscripts)};
 170     if (listOutput) {
 171       if (!ListDirectedCharacterOutput(io, *listOutput, x, length)) {
 172         return false;
 173       }
 174     } else if (auto edit{io.GetNextDataEdit()}) {
 175       if constexpr (DIR == Direction::Output) {
 176         if (!EditCharacterOutput(io, *edit, x, length)) {
 177           return false;
 178         }
 179       } else { // input
 180         if (edit->descriptor != DataEdit::ListDirectedNullValue) {
 181           if (EditCharacterInput(io, *edit, x, length)) {
 182             anyInput = true;
 183           } else {
 184             return anyInput && edit->IsNamelist();
 185           }
 186         }
 187       }
 188     } else {
 189       return false;
 190     }
 191     if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
 192       io.GetIoErrorHandler().Crash(
 193           "FormattedCharacterIO: subscripts out of bounds");
 194     }
 195   }
 196   return true;
 197 }
 198
 199 template <int KIND, Direction DIR>
 200 inline bool FormattedLogicalIO(
 201     IoStatementState &io, const Descriptor &descriptor) {
 202   std::size_t numElements{descriptor.Elements()};
 203   SubscriptValue subscripts[maxRank];
 204   descriptor.GetLowerBounds(subscripts);
 205   auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
 206   using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
 207   bool anyInput{false};
 208   for (std::size_t j{0}; j < numElements; ++j) {
 209     IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
 210     if (listOutput) {
 211       if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) {
 212         return false;
 213       }
 214     } else if (auto edit{io.GetNextDataEdit()}) {
 215       if constexpr (DIR == Direction::Output) {
 216         if (!EditLogicalOutput(io, *edit, x != 0)) {
 217           return false;
 218         }
 219       } else {
 220         if (edit->descriptor != DataEdit::ListDirectedNullValue) {
 221           bool truth{};
 222           if (EditLogicalInput(io, *edit, truth)) {
 223             x = truth;
 224             anyInput = true;
 225           } else {
 226             return anyInput && edit->IsNamelist();
 227           }
 228         }
 229       }
 230     } else {
 231       return false;
 232     }
 233     if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
 234       io.GetIoErrorHandler().Crash(
 235           "FormattedLogicalIO: subscripts out of bounds");
 236     }
 237   }
 238   return true;
 239 }
 240
 241 template <Direction DIR>
 242 static bool DescriptorIO(IoStatementState &, const Descriptor &);
 243
 244 // For default (not user-defined) derived type I/O, formatted & unformatted
 245 template <Direction DIR>
 246 static bool DefaultComponentIO(IoStatementState &io,
 247     const typeInfo::Component &component, const Descriptor &origDescriptor,
 248     const SubscriptValue origSubscripts[], Terminator &terminator) {
 249   if (component.genre() == typeInfo::Component::Genre::Data) {
 250     // Create a descriptor for the component
 251     StaticDescriptor<maxRank, true, 16 /*?*/> statDesc;
 252     Descriptor &desc{statDesc.descriptor()};
 253     component.CreatePointerDescriptor(
 254         desc, origDescriptor, terminator, origSubscripts);
 255     return DescriptorIO<DIR>(io, desc);
 256   } else {
 257     // Component is itself a descriptor
 258     char *pointer{
 259         origDescriptor.Element<char>(origSubscripts) + component.offset()};
 260     RUNTIME_CHECK(
 261         terminator, component.genre() == typeInfo::Component::Genre::Automatic);
 262     const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)};
 263     return DescriptorIO<DIR>(io, compDesc);
 264   }
 265 }
 266
 267 template <Direction DIR>
 268 static bool DefaultComponentwiseIO(IoStatementState &io,
 269     const Descriptor &descriptor, const typeInfo::DerivedType &type) {
 270   IoErrorHandler &handler{io.GetIoErrorHandler()};
 271   const Descriptor &compArray{type.component()};
 272   RUNTIME_CHECK(handler, compArray.rank() == 1);
 273   std::size_t numComponents{compArray.Elements()};
 274   std::size_t numElements{descriptor.Elements()};
 275   SubscriptValue subscripts[maxRank];
 276   descriptor.GetLowerBounds(subscripts);
 277   for (std::size_t j{0}; j < numElements;
 278        ++j, descriptor.IncrementSubscripts(subscripts)) {
 279     SubscriptValue at[maxRank];
 280     compArray.GetLowerBounds(at);
 281     for (std::size_t k{0}; k < numComponents;
 282          ++k, compArray.IncrementSubscripts(at)) {
 283       const typeInfo::Component &component{
 284           *compArray.Element<typeInfo::Component>(at)};
 285       if (!DefaultComponentIO<DIR>(
 286               io, component, descriptor, subscripts, handler)) {
 287         return false;
 288       }
 289     }
 290   }
 291   return true;
 292 }
 293
 294 std::optional<bool> DefinedFormattedIo(
 295     IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &);
 296
 297 template <Direction DIR>
 298 static bool FormattedDerivedTypeIO(
 299     IoStatementState &io, const Descriptor &descriptor) {
 300   IoErrorHandler &handler{io.GetIoErrorHandler()};
 301   // Derived type information must be present for formatted I/O.
 302   const DescriptorAddendum *addendum{descriptor.Addendum()};
 303   RUNTIME_CHECK(handler, addendum != nullptr);
 304   const typeInfo::DerivedType *type{addendum->derivedType()};
 305   RUNTIME_CHECK(handler, type != nullptr);
 306   if (const typeInfo::SpecialBinding *
 307       special{type->FindSpecialBinding(DIR == Direction::Input
 308               ? typeInfo::SpecialBinding::Which::ReadFormatted
 309               : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
 310     if (std::optional<bool> wasDefined{
 311             DefinedFormattedIo(io, descriptor, *special)}) {
 312       return *wasDefined; // user-defined I/O was applied
 313     }
 314   }
 315   return DefaultComponentwiseIO<DIR>(io, descriptor, *type);
 316 }
 317
 318 bool DefinedUnformattedIo(
 319     IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &);
 320
 321 // Unformatted I/O
 322 template <Direction DIR>
 323 static bool UnformattedDescriptorIO(
 324     IoStatementState &io, const Descriptor &descriptor) {
 325   IoErrorHandler &handler{io.GetIoErrorHandler()};
 326   const DescriptorAddendum *addendum{descriptor.Addendum()};
 327   if (const typeInfo::DerivedType *
 328       type{addendum ? addendum->derivedType() : nullptr}) {
 329     // derived type unformatted I/O
 330     if (const typeInfo::SpecialBinding *
 331         special{type->FindSpecialBinding(DIR == Direction::Input
 332                 ? typeInfo::SpecialBinding::Which::ReadUnformatted
 333                 : typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
 334       // User-defined derived type unformatted I/O
 335       return DefinedUnformattedIo(io, descriptor, *special);
 336     } else {
 337       // Default derived type unformatted I/O
 338       // TODO: If no component at any level has user defined READ or WRITE
 339       // (as appropriate), the elements are contiguous, and no byte swapping
 340       // is active, do a block transfer via the code below.
 341       return DefaultComponentwiseIO<DIR>(io, descriptor, *type);
 342     }
 343   } else {
 344     // intrinsic type unformatted I/O
 345     auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
 346     auto *childUnf{io.get_if<ChildUnformattedIoStatementState<DIR>>()};
 347     auto *inq{
 348         DIR == Direction::Output ? io.get_if<InquireIOLengthState>() : nullptr};
 349     RUNTIME_CHECK(handler, externalUnf || childUnf || inq);
 350     std::size_t elementBytes{descriptor.ElementBytes()};
 351     std::size_t numElements{descriptor.Elements()};
 352     std::size_t swappingBytes{elementBytes};
 353     if (auto maybeCatAndKind{descriptor.type().GetCategoryAndKind()}) {
 354       // Byte swapping units can be smaller than elements, namely
 355       // for COMPLEX and CHARACTER.
 356       if (maybeCatAndKind->first == TypeCategory::Character) {
 357         // swap each character position independently
 358         swappingBytes = maybeCatAndKind->second; // kind
 359       } else if (maybeCatAndKind->first == TypeCategory::Complex) {
 360         // swap real and imaginary components independently
 361         swappingBytes /= 2;
 362       }
 363     }
 364     SubscriptValue subscripts[maxRank];
 365     descriptor.GetLowerBounds(subscripts);
 366     using CharType =
 367         std::conditional_t<DIR == Direction::Output, const char, char>;
 368     auto Transfer{[=](CharType &x, std::size_t totalBytes) -> bool {
 369       if constexpr (DIR == Direction::Output) {
 370         return externalUnf ? externalUnf->Emit(&x, totalBytes, swappingBytes)
 371             : childUnf     ? childUnf->Emit(&x, totalBytes, swappingBytes)
 372                            : inq->Emit(&x, totalBytes, swappingBytes);
 373       } else {
 374         return externalUnf ? externalUnf->Receive(&x, totalBytes, swappingBytes)
 375                            : childUnf->Receive(&x, totalBytes, swappingBytes);
 376       }
 377     }};
 378     bool swapEndianness{externalUnf && externalUnf->unit().swapEndianness()};
 379     if (!swapEndianness &&
 380         descriptor.IsContiguous()) { // contiguous unformatted I/O
 381       char &x{ExtractElement<char>(io, descriptor, subscripts)};
 382       return Transfer(x, numElements * elementBytes);
 383     } else { // non-contiguous or byte-swapped intrinsic type unformatted I/O
 384       for (std::size_t j{0}; j < numElements; ++j) {
 385         char &x{ExtractElement<char>(io, descriptor, subscripts)};
 386         if (!Transfer(x, elementBytes)) {
 387           return false;
 388         }
 389         if (!descriptor.IncrementSubscripts(subscripts) &&
 390             j + 1 < numElements) {
 391           handler.Crash("DescriptorIO: subscripts out of bounds");
 392         }
 393       }
 394       return true;
 395     }
 396   }
 397 }
 398
 399 template <Direction DIR>
 400 static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
 401   IoErrorHandler &handler{io.GetIoErrorHandler()};
 402   if (handler.InError()) {
 403     return false;
 404   }
 405   if (!io.get_if<IoDirectionState<DIR>>()) {
 406     io.GetIoErrorHandler().Crash(
 407         "DescriptorIO() called for wrong I/O direction");
 408     return false;
 409   }
 410   if constexpr (DIR == Direction::Input) {
 411     if (!io.BeginReadingRecord()) {
 412       return false;
 413     }
 414   }
 415   if (!io.get_if<FormattedIoStatementState<DIR>>()) {
 416     return UnformattedDescriptorIO<DIR>(io, descriptor);
 417   }
 418   if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
 419     TypeCategory cat{catAndKind->first};
 420     int kind{catAndKind->second};
 421     switch (cat) {
 422     case TypeCategory::Integer:
 423       switch (kind) {
 424       case 1:
 425         return FormattedIntegerIO<1, DIR>(io, descriptor);
 426       case 2:
 427         return FormattedIntegerIO<2, DIR>(io, descriptor);
 428       case 4:
 429         return FormattedIntegerIO<4, DIR>(io, descriptor);
 430       case 8:
 431         return FormattedIntegerIO<8, DIR>(io, descriptor);
 432       case 16:
 433         return FormattedIntegerIO<16, DIR>(io, descriptor);
 434       default:
 435         handler.Crash(
 436             "DescriptorIO: Unimplemented INTEGER kind (%d) in descriptor",
 437             kind);
 438         return false;
 439       }
 440     case TypeCategory::Real:
 441       switch (kind) {
 442       case 2:
 443         return FormattedRealIO<2, DIR>(io, descriptor);
 444       case 3:
 445         return FormattedRealIO<3, DIR>(io, descriptor);
 446       case 4:
 447         return FormattedRealIO<4, DIR>(io, descriptor);
 448       case 8:
 449         return FormattedRealIO<8, DIR>(io, descriptor);
 450       case 10:
 451         return FormattedRealIO<10, DIR>(io, descriptor);
 452       // TODO: case double/double
 453       case 16:
 454         return FormattedRealIO<16, DIR>(io, descriptor);
 455       default:
 456         handler.Crash(
 457             "DescriptorIO: Unimplemented REAL kind (%d) in descriptor", kind);
 458         return false;
 459       }
 460     case TypeCategory::Complex:
 461       switch (kind) {
 462       case 2:
 463         return FormattedComplexIO<2, DIR>(io, descriptor);
 464       case 3:
 465         return FormattedComplexIO<3, DIR>(io, descriptor);
 466       case 4:
 467         return FormattedComplexIO<4, DIR>(io, descriptor);
 468       case 8:
 469         return FormattedComplexIO<8, DIR>(io, descriptor);
 470       case 10:
 471         return FormattedComplexIO<10, DIR>(io, descriptor);
 472       // TODO: case double/double
 473       case 16:
 474         return FormattedComplexIO<16, DIR>(io, descriptor);
 475       default:
 476         handler.Crash(
 477             "DescriptorIO: Unimplemented COMPLEX kind (%d) in descriptor",
 478             kind);
 479         return false;
 480       }
 481     case TypeCategory::Character:
 482       switch (kind) {
 483       case 1:
 484         return FormattedCharacterIO<char, DIR>(io, descriptor);
 485       case 2:
 486         return FormattedCharacterIO<char16_t, DIR>(io, descriptor);
 487       case 4:
 488         return FormattedCharacterIO<char32_t, DIR>(io, descriptor);
 489       default:
 490         handler.Crash(
 491             "DescriptorIO: Unimplemented CHARACTER kind (%d) in descriptor",
 492             kind);
 493         return false;
 494       }
 495     case TypeCategory::Logical:
 496       switch (kind) {
 497       case 1:
 498         return FormattedLogicalIO<1, DIR>(io, descriptor);
 499       case 2:
 500         return FormattedLogicalIO<2, DIR>(io, descriptor);
 501       case 4:
 502         return FormattedLogicalIO<4, DIR>(io, descriptor);
 503       case 8:
 504         return FormattedLogicalIO<8, DIR>(io, descriptor);
 505       default:
 506         handler.Crash(
 507             "DescriptorIO: Unimplemented LOGICAL kind (%d) in descriptor",
 508             kind);
 509         return false;
 510       }
 511     case TypeCategory::Derived:
 512       return FormattedDerivedTypeIO<DIR>(io, descriptor);
 513     }
 514   }
 515   handler.Crash("DescriptorIO: bad type code (%d) in descriptor",
 516       static_cast<int>(descriptor.type().raw()));
 517   return false;
 518 }
 519 } // namespace Fortran::runtime::io::descr
 520 #endif // FORTRAN_RUNTIME_DESCRIPTOR_IO_H_