//===-- runtime/descriptor-io.h ---------------------------------*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// #ifndef FORTRAN_RUNTIME_DESCRIPTOR_IO_H_ #define FORTRAN_RUNTIME_DESCRIPTOR_IO_H_ // Implementation of I/O data list item transfers based on descriptors. #include "descriptor.h" #include "edit-input.h" #include "edit-output.h" #include "io-stmt.h" #include "terminator.h" #include "flang/Common/uint128.h" namespace Fortran::runtime::io::descr { template inline A &ExtractElement(IoStatementState &io, const Descriptor &descriptor, const SubscriptValue subscripts[]) { A *p{descriptor.Element(subscripts)}; if (!p) { io.GetIoErrorHandler().Crash("ExtractElement: subscripts out of range"); } return *p; } // Per-category descriptor-based I/O templates template inline bool FormattedIntegerIO( IoStatementState &io, const Descriptor &descriptor) { std::size_t numElements{descriptor.Elements()}; SubscriptValue subscripts[maxRank]; descriptor.GetLowerBounds(subscripts); for (std::size_t j{0}; j < numElements; ++j) { if (auto edit{io.GetNextDataEdit()}) { A &x{ExtractElement(io, descriptor, subscripts)}; if constexpr (DIR == Direction::Output) { if (!EditIntegerOutput(io, *edit, static_cast(x))) { return false; } } else if (edit->descriptor != DataEdit::ListDirectedNullValue) { if (!EditIntegerInput(io, *edit, reinterpret_cast(&x), static_cast(sizeof(A)))) { return false; } } if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { io.GetIoErrorHandler().Crash( "FormattedIntegerIO: subscripts out of bounds"); } } else { return false; } } return true; } template inline bool FormattedRealIO( IoStatementState &io, const Descriptor &descriptor) { std::size_t numElements{descriptor.Elements()}; SubscriptValue subscripts[maxRank]; descriptor.GetLowerBounds(subscripts); using RawType = typename RealOutputEditing::BinaryFloatingPoint; for (std::size_t j{0}; j < numElements; ++j) { if (auto edit{io.GetNextDataEdit()}) { RawType &x{ExtractElement(io, descriptor, subscripts)}; if constexpr (DIR == Direction::Output) { if (!RealOutputEditing{io, x}.Edit(*edit)) { return false; } } else if (edit->descriptor != DataEdit::ListDirectedNullValue) { if (!EditRealInput(io, *edit, reinterpret_cast(&x))) { return false; } } if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { io.GetIoErrorHandler().Crash( "FormattedRealIO: subscripts out of bounds"); } } else { return false; } } return true; } template inline bool FormattedComplexIO( IoStatementState &io, const Descriptor &descriptor) { std::size_t numElements{descriptor.Elements()}; SubscriptValue subscripts[maxRank]; descriptor.GetLowerBounds(subscripts); bool isListOutput{ io.get_if>() != nullptr}; using RawType = typename RealOutputEditing::BinaryFloatingPoint; for (std::size_t j{0}; j < numElements; ++j) { RawType *x{&ExtractElement(io, descriptor, subscripts)}; if (isListOutput) { DataEdit rEdit, iEdit; rEdit.descriptor = DataEdit::ListDirectedRealPart; iEdit.descriptor = DataEdit::ListDirectedImaginaryPart; if (!RealOutputEditing{io, x[0]}.Edit(rEdit) || !RealOutputEditing{io, x[1]}.Edit(iEdit)) { return false; } } else { for (int k{0}; k < 2; ++k, ++x) { auto edit{io.GetNextDataEdit()}; if (!edit) { return false; } else if constexpr (DIR == Direction::Output) { if (!RealOutputEditing{io, *x}.Edit(*edit)) { return false; } } else if (edit->descriptor == DataEdit::ListDirectedNullValue) { break; } else if (!EditRealInput( io, *edit, reinterpret_cast(x))) { return false; } } } if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { io.GetIoErrorHandler().Crash( "FormattedComplexIO: subscripts out of bounds"); } } return true; } template inline bool FormattedCharacterIO( IoStatementState &io, const Descriptor &descriptor) { std::size_t numElements{descriptor.Elements()}; SubscriptValue subscripts[maxRank]; descriptor.GetLowerBounds(subscripts); std::size_t length{descriptor.ElementBytes() / sizeof(A)}; auto *listOutput{io.get_if>()}; for (std::size_t j{0}; j < numElements; ++j) { A *x{&ExtractElement(io, descriptor, subscripts)}; if (listOutput) { if (!ListDirectedDefaultCharacterOutput(io, *listOutput, x, length)) { return false; } } else if (auto edit{io.GetNextDataEdit()}) { if constexpr (DIR == Direction::Output) { if (!EditDefaultCharacterOutput(io, *edit, x, length)) { return false; } } else { if (edit->descriptor != DataEdit::ListDirectedNullValue) { if (!EditDefaultCharacterInput(io, *edit, x, length)) { return false; } } } } else { return false; } if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { io.GetIoErrorHandler().Crash( "FormattedCharacterIO: subscripts out of bounds"); } } return true; } template inline bool FormattedLogicalIO( IoStatementState &io, const Descriptor &descriptor) { std::size_t numElements{descriptor.Elements()}; SubscriptValue subscripts[maxRank]; descriptor.GetLowerBounds(subscripts); auto *listOutput{io.get_if>()}; for (std::size_t j{0}; j < numElements; ++j) { A &x{ExtractElement(io, descriptor, subscripts)}; if (listOutput) { if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) { return false; } } else if (auto edit{io.GetNextDataEdit()}) { if constexpr (DIR == Direction::Output) { if (!EditLogicalOutput(io, *edit, x != 0)) { return false; } } else { if (edit->descriptor != DataEdit::ListDirectedNullValue) { bool truth{}; if (EditLogicalInput(io, *edit, truth)) { x = truth; } else { return false; } } } } else { return false; } if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { io.GetIoErrorHandler().Crash( "FormattedLogicalIO: subscripts out of bounds"); } } return true; } template static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) { if (!io.get_if>()) { io.GetIoErrorHandler().Crash( "DescriptorIO() called for wrong I/O direction"); return false; } if constexpr (DIR == Direction::Input) { io.BeginReadingRecord(); } if (auto *unf{io.get_if>()}) { std::size_t elementBytes{descriptor.ElementBytes()}; SubscriptValue subscripts[maxRank]; descriptor.GetLowerBounds(subscripts); std::size_t numElements{descriptor.Elements()}; if (descriptor.IsContiguous()) { // contiguous unformatted I/O char &x{ExtractElement(io, descriptor, subscripts)}; auto totalBytes{numElements * elementBytes}; if constexpr (DIR == Direction::Output) { return unf->Emit(&x, totalBytes, elementBytes); } else { return unf->Receive(&x, totalBytes, elementBytes); } } else { // non-contiguous unformatted I/O for (std::size_t j{0}; j < numElements; ++j) { char &x{ExtractElement(io, descriptor, subscripts)}; if constexpr (DIR == Direction::Output) { if (!unf->Emit(&x, elementBytes, elementBytes)) { return false; } } else { if (!unf->Receive(&x, elementBytes, elementBytes)) { return false; } } if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { io.GetIoErrorHandler().Crash( "DescriptorIO: subscripts out of bounds"); } } return true; } } else if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) { int kind{catAndKind->second}; switch (catAndKind->first) { case TypeCategory::Integer: switch (kind) { case 1: return FormattedIntegerIO(io, descriptor); case 2: return FormattedIntegerIO(io, descriptor); case 4: return FormattedIntegerIO(io, descriptor); case 8: return FormattedIntegerIO(io, descriptor); case 16: return FormattedIntegerIO(io, descriptor); default: io.GetIoErrorHandler().Crash( "DescriptorIO: Unimplemented INTEGER kind (%d) in descriptor", kind); return false; } case TypeCategory::Real: switch (kind) { case 2: return FormattedRealIO<2, DIR>(io, descriptor); case 3: return FormattedRealIO<3, DIR>(io, descriptor); case 4: return FormattedRealIO<4, DIR>(io, descriptor); case 8: return FormattedRealIO<8, DIR>(io, descriptor); case 10: return FormattedRealIO<10, DIR>(io, descriptor); // TODO: case double/double case 16: return FormattedRealIO<16, DIR>(io, descriptor); default: io.GetIoErrorHandler().Crash( "DescriptorIO: Unimplemented REAL kind (%d) in descriptor", kind); return false; } case TypeCategory::Complex: switch (kind) { case 2: return FormattedComplexIO<2, DIR>(io, descriptor); case 3: return FormattedComplexIO<3, DIR>(io, descriptor); case 4: return FormattedComplexIO<4, DIR>(io, descriptor); case 8: return FormattedComplexIO<8, DIR>(io, descriptor); case 10: return FormattedComplexIO<10, DIR>(io, descriptor); // TODO: case double/double case 16: return FormattedComplexIO<16, DIR>(io, descriptor); default: io.GetIoErrorHandler().Crash( "DescriptorIO: Unimplemented COMPLEX kind (%d) in descriptor", kind); return false; } case TypeCategory::Character: switch (kind) { case 1: return FormattedCharacterIO(io, descriptor); // TODO cases 2, 4 default: io.GetIoErrorHandler().Crash( "DescriptorIO: Unimplemented CHARACTER kind (%d) in descriptor", kind); return false; } case TypeCategory::Logical: switch (kind) { case 1: return FormattedLogicalIO(io, descriptor); case 2: return FormattedLogicalIO(io, descriptor); case 4: return FormattedLogicalIO(io, descriptor); case 8: return FormattedLogicalIO(io, descriptor); default: io.GetIoErrorHandler().Crash( "DescriptorIO: Unimplemented LOGICAL kind (%d) in descriptor", kind); return false; } case TypeCategory::Derived: io.GetIoErrorHandler().Crash( "DescriptorIO: Unimplemented: derived type I/O", static_cast(descriptor.type().raw())); return false; } } io.GetIoErrorHandler().Crash("DescriptorIO: Bad type code (%d) in descriptor", static_cast(descriptor.type().raw())); return false; } } // namespace Fortran::runtime::io::descr #endif // FORTRAN_RUNTIME_DESCRIPTOR_IO_H_