llvm-capstone/flang/runtime/descriptor-io.h
peter klausler d56fdc8e95 [flang][msvc] Avoid dependence on long double
MSVC does not support a distinct 80-bit extended precision
"long double" type.  Rework the I/O runtime to avoid using
native C/C++ type names.  Centralize the mappings between
the KIND= type parameters of REAL and their binary precisions
in the common real.h header file, and use KIND type parameter
values rather than binary precisions for clarity where
appropriate.

This patch, if successful, should obviate the need for
Differential review D88511.

(This patch anticipates a successful review of D88688, which
fixes the function that maps each kind of real to its maximum
number of significant decimal digits.)

Differential revision: https://reviews.llvm.org/D88752
2020-10-07 15:12:08 -07:00

359 lines
12 KiB
C++

//===-- 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 <typename A>
inline A &ExtractElement(IoStatementState &io, const Descriptor &descriptor,
const SubscriptValue subscripts[]) {
A *p{descriptor.Element<A>(subscripts)};
if (!p) {
io.GetIoErrorHandler().Crash("ExtractElement: subscripts out of range");
}
return *p;
}
// Per-category descriptor-based I/O templates
template <typename A, Direction DIR>
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<A>(io, descriptor, subscripts)};
if constexpr (DIR == Direction::Output) {
if (!EditIntegerOutput(io, *edit, static_cast<std::int64_t>(x))) {
return false;
}
} else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
if (!EditIntegerInput(io, *edit, reinterpret_cast<void *>(&x),
static_cast<int>(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 <int KIND, Direction DIR>
inline bool FormattedRealIO(
IoStatementState &io, const Descriptor &descriptor) {
std::size_t numElements{descriptor.Elements()};
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
for (std::size_t j{0}; j < numElements; ++j) {
if (auto edit{io.GetNextDataEdit()}) {
RawType &x{ExtractElement<RawType>(io, descriptor, subscripts)};
if constexpr (DIR == Direction::Output) {
if (!RealOutputEditing<KIND>{io, x}.Edit(*edit)) {
return false;
}
} else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
if (!EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) {
return false;
}
}
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
io.GetIoErrorHandler().Crash(
"FormattedRealIO: subscripts out of bounds");
}
} else {
return false;
}
}
return true;
}
template <int KIND, Direction DIR>
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<ListDirectedStatementState<Direction::Output>>() != nullptr};
using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
for (std::size_t j{0}; j < numElements; ++j) {
RawType *x{&ExtractElement<RawType>(io, descriptor, subscripts)};
if (isListOutput) {
DataEdit rEdit, iEdit;
rEdit.descriptor = DataEdit::ListDirectedRealPart;
iEdit.descriptor = DataEdit::ListDirectedImaginaryPart;
if (!RealOutputEditing<KIND>{io, x[0]}.Edit(rEdit) ||
!RealOutputEditing<KIND>{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<KIND>{io, *x}.Edit(*edit)) {
return false;
}
} else if (edit->descriptor == DataEdit::ListDirectedNullValue) {
break;
} else if (!EditRealInput<KIND>(
io, *edit, reinterpret_cast<void *>(x))) {
return false;
}
}
}
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
io.GetIoErrorHandler().Crash(
"FormattedComplexIO: subscripts out of bounds");
}
}
return true;
}
template <typename A, Direction DIR>
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<ListDirectedStatementState<Direction::Output>>()};
for (std::size_t j{0}; j < numElements; ++j) {
A *x{&ExtractElement<A>(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 <typename A, Direction DIR>
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<ListDirectedStatementState<Direction::Output>>()};
for (std::size_t j{0}; j < numElements; ++j) {
A &x{ExtractElement<A>(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 <Direction DIR>
static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
if (!io.get_if<IoDirectionState<DIR>>()) {
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<UnformattedIoStatementState<DIR>>()}) {
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<char>(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<char>(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<std::int8_t, DIR>(io, descriptor);
case 2:
return FormattedIntegerIO<std::int16_t, DIR>(io, descriptor);
case 4:
return FormattedIntegerIO<std::int32_t, DIR>(io, descriptor);
case 8:
return FormattedIntegerIO<std::int64_t, DIR>(io, descriptor);
case 16:
return FormattedIntegerIO<common::uint128_t, DIR>(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<char, DIR>(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<std::int8_t, DIR>(io, descriptor);
case 2:
return FormattedLogicalIO<std::int16_t, DIR>(io, descriptor);
case 4:
return FormattedLogicalIO<std::int32_t, DIR>(io, descriptor);
case 8:
return FormattedLogicalIO<std::int64_t, DIR>(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<int>(descriptor.type().raw()));
return false;
}
}
io.GetIoErrorHandler().Crash("DescriptorIO: Bad type code (%d) in descriptor",
static_cast<int>(descriptor.type().raw()));
return false;
}
} // namespace Fortran::runtime::io::descr
#endif // FORTRAN_RUNTIME_DESCRIPTOR_IO_H_