9#ifndef FORTRAN_RUNTIME_DESCRIPTOR_IO_H_
10#define FORTRAN_RUNTIME_DESCRIPTOR_IO_H_
17#include "edit-input.h"
18#include "edit-output.h"
21#include "terminator.h"
24#include "flang/Common/optional.h"
25#include "flang/Common/uint128.h"
26#include "flang/Runtime/cpp-type.h"
27#include "flang/Runtime/descriptor.h"
29namespace Fortran::runtime::io::descr {
31inline RT_API_ATTRS A &ExtractElement(IoStatementState &io,
32 const Descriptor &descriptor,
const SubscriptValue subscripts[]) {
33 A *p{descriptor.Element<A>(subscripts)};
35 io.GetIoErrorHandler().Crash(
"Bad address for I/O item -- null base "
36 "address or subscripts out of range");
47template <
int KIND, Direction DIR>
48inline RT_API_ATTRS
bool FormattedIntegerIO(IoStatementState &io,
49 const Descriptor &descriptor, [[maybe_unused]]
bool isSigned) {
50 std::size_t numElements{descriptor.Elements()};
51 SubscriptValue subscripts[maxRank];
52 descriptor.GetLowerBounds(subscripts);
53 using IntType = CppTypeFor<common::TypeCategory::Integer, KIND>;
55 for (std::size_t j{0}; j < numElements; ++j) {
56 if (
auto edit{io.GetNextDataEdit()}) {
57 IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
58 if constexpr (DIR == Direction::Output) {
59 if (!EditIntegerOutput<KIND>(io, *edit, x, isSigned)) {
62 }
else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
64 io, *edit,
reinterpret_cast<void *
>(&x), KIND, isSigned)) {
67 return anyInput && edit->IsNamelist();
70 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
71 io.GetIoErrorHandler().Crash(
72 "FormattedIntegerIO: subscripts out of bounds");
81template <
int KIND, Direction DIR>
82inline RT_API_ATTRS
bool FormattedRealIO(
83 IoStatementState &io,
const Descriptor &descriptor) {
84 std::size_t numElements{descriptor.Elements()};
85 SubscriptValue subscripts[maxRank];
86 descriptor.GetLowerBounds(subscripts);
87 using RawType =
typename RealOutputEditing<KIND>::BinaryFloatingPoint;
89 for (std::size_t j{0}; j < numElements; ++j) {
90 if (
auto edit{io.GetNextDataEdit()}) {
91 RawType &x{ExtractElement<RawType>(io, descriptor, subscripts)};
92 if constexpr (DIR == Direction::Output) {
93 if (!RealOutputEditing<KIND>{io, x}.Edit(*edit)) {
96 }
else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
97 if (EditRealInput<KIND>(io, *edit,
reinterpret_cast<void *
>(&x))) {
100 return anyInput && edit->IsNamelist();
103 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
104 io.GetIoErrorHandler().Crash(
105 "FormattedRealIO: subscripts out of bounds");
114template <
int KIND, Direction DIR>
115inline RT_API_ATTRS
bool FormattedComplexIO(
116 IoStatementState &io,
const Descriptor &descriptor) {
117 std::size_t numElements{descriptor.Elements()};
118 SubscriptValue subscripts[maxRank];
119 descriptor.GetLowerBounds(subscripts);
121 io.get_if<ListDirectedStatementState<Direction::Output>>() !=
nullptr};
122 using RawType =
typename RealOutputEditing<KIND>::BinaryFloatingPoint;
123 bool anyInput{
false};
124 for (std::size_t j{0}; j < numElements; ++j) {
125 RawType *x{&ExtractElement<RawType>(io, descriptor, subscripts)};
127 DataEdit rEdit, iEdit;
128 rEdit.descriptor = DataEdit::ListDirectedRealPart;
129 iEdit.descriptor = DataEdit::ListDirectedImaginaryPart;
130 rEdit.modes = iEdit.modes = io.mutableModes();
131 if (!RealOutputEditing<KIND>{io, x[0]}.Edit(rEdit) ||
132 !RealOutputEditing<KIND>{io, x[1]}.Edit(iEdit)) {
136 for (
int k{0}; k < 2; ++k, ++x) {
137 auto edit{io.GetNextDataEdit()};
140 }
else if constexpr (DIR == Direction::Output) {
141 if (!RealOutputEditing<KIND>{io, *x}.Edit(*edit)) {
144 }
else if (edit->descriptor == DataEdit::ListDirectedNullValue) {
146 }
else if (EditRealInput<KIND>(
147 io, *edit,
reinterpret_cast<void *
>(x))) {
150 return anyInput && edit->IsNamelist();
154 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
155 io.GetIoErrorHandler().Crash(
156 "FormattedComplexIO: subscripts out of bounds");
162template <
typename A, Direction DIR>
163inline RT_API_ATTRS
bool FormattedCharacterIO(
164 IoStatementState &io,
const Descriptor &descriptor) {
165 std::size_t numElements{descriptor.Elements()};
166 SubscriptValue subscripts[maxRank];
167 descriptor.GetLowerBounds(subscripts);
168 std::size_t length{descriptor.ElementBytes() /
sizeof(A)};
169 auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
170 bool anyInput{
false};
171 for (std::size_t j{0}; j < numElements; ++j) {
172 A *x{&ExtractElement<A>(io, descriptor, subscripts)};
174 if (!ListDirectedCharacterOutput(io, *listOutput, x, length)) {
177 }
else if (
auto edit{io.GetNextDataEdit()}) {
178 if constexpr (DIR == Direction::Output) {
179 if (!EditCharacterOutput(io, *edit, x, length)) {
183 if (edit->descriptor != DataEdit::ListDirectedNullValue) {
184 if (EditCharacterInput(io, *edit, x, length)) {
187 return anyInput && edit->IsNamelist();
194 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
195 io.GetIoErrorHandler().Crash(
196 "FormattedCharacterIO: subscripts out of bounds");
202template <
int KIND, Direction DIR>
203inline RT_API_ATTRS
bool FormattedLogicalIO(
204 IoStatementState &io,
const Descriptor &descriptor) {
205 std::size_t numElements{descriptor.Elements()};
206 SubscriptValue subscripts[maxRank];
207 descriptor.GetLowerBounds(subscripts);
208 auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
209 using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
210 bool anyInput{
false};
211 for (std::size_t j{0}; j < numElements; ++j) {
212 IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
214 if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) {
217 }
else if (
auto edit{io.GetNextDataEdit()}) {
218 if constexpr (DIR == Direction::Output) {
219 if (!EditLogicalOutput(io, *edit, x != 0)) {
223 if (edit->descriptor != DataEdit::ListDirectedNullValue) {
225 if (EditLogicalInput(io, *edit, truth)) {
229 return anyInput && edit->IsNamelist();
236 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
237 io.GetIoErrorHandler().Crash(
238 "FormattedLogicalIO: subscripts out of bounds");
244template <Direction DIR>
245static RT_API_ATTRS
bool DescriptorIO(IoStatementState &,
const Descriptor &,
246 const NonTbpDefinedIoTable * =
nullptr);
249template <Direction DIR>
250static RT_API_ATTRS
bool DefaultComponentIO(IoStatementState &io,
251 const typeInfo::Component &component,
const Descriptor &origDescriptor,
252 const SubscriptValue origSubscripts[], Terminator &terminator,
253 const NonTbpDefinedIoTable *table) {
254#if !defined(RT_DEVICE_AVOID_RECURSION)
255 if (component.genre() == typeInfo::Component::Genre::Data) {
257 StaticDescriptor<maxRank,
true, 16 > statDesc;
258 Descriptor &desc{statDesc.descriptor()};
259 component.CreatePointerDescriptor(
260 desc, origDescriptor, terminator, origSubscripts);
261 return DescriptorIO<DIR>(io, desc, table);
265 origDescriptor.Element<
char>(origSubscripts) + component.offset()};
267 terminator, component.genre() == typeInfo::Component::Genre::Automatic);
268 const Descriptor &compDesc{*
reinterpret_cast<const Descriptor *
>(pointer)};
269 return DescriptorIO<DIR>(io, compDesc, table);
272 terminator.Crash(
"not yet implemented: component IO");
276template <Direction DIR>
277static RT_API_ATTRS
bool DefaultComponentwiseFormattedIO(IoStatementState &io,
278 const Descriptor &descriptor,
const typeInfo::DerivedType &type,
279 const NonTbpDefinedIoTable *table,
const SubscriptValue subscripts[]) {
280 IoErrorHandler &handler{io.GetIoErrorHandler()};
281 const Descriptor &compArray{type.component()};
282 RUNTIME_CHECK(handler, compArray.rank() == 1);
283 std::size_t numComponents{compArray.Elements()};
284 SubscriptValue at[maxRank];
285 compArray.GetLowerBounds(at);
286 for (std::size_t k{0}; k < numComponents;
287 ++k, compArray.IncrementSubscripts(at)) {
288 const typeInfo::Component &component{
289 *compArray.Element<typeInfo::Component>(at)};
290 if (!DefaultComponentIO<DIR>(
291 io, component, descriptor, subscripts, handler, table)) {
294 io.get_if<ListDirectedStatementState<Direction::Input>>()};
295 return DIR == Direction::Input && k > 0 && listInput &&
296 listInput->inNamelistSequence();
302template <Direction DIR>
303static RT_API_ATTRS
bool DefaultComponentwiseUnformattedIO(IoStatementState &io,
304 const Descriptor &descriptor,
const typeInfo::DerivedType &type,
305 const NonTbpDefinedIoTable *table) {
306 IoErrorHandler &handler{io.GetIoErrorHandler()};
307 const Descriptor &compArray{type.component()};
308 RUNTIME_CHECK(handler, compArray.rank() == 1);
309 std::size_t numComponents{compArray.Elements()};
310 std::size_t numElements{descriptor.Elements()};
311 SubscriptValue subscripts[maxRank];
312 descriptor.GetLowerBounds(subscripts);
313 for (std::size_t j{0}; j < numElements;
314 ++j, descriptor.IncrementSubscripts(subscripts)) {
315 SubscriptValue at[maxRank];
316 compArray.GetLowerBounds(at);
317 for (std::size_t k{0}; k < numComponents;
318 ++k, compArray.IncrementSubscripts(at)) {
319 const typeInfo::Component &component{
320 *compArray.Element<typeInfo::Component>(at)};
321 if (!DefaultComponentIO<DIR>(
322 io, component, descriptor, subscripts, handler, table)) {
330RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
331 IoStatementState &,
const Descriptor &,
const typeInfo::DerivedType &,
332 const typeInfo::SpecialBinding &,
const SubscriptValue[]);
334template <Direction DIR>
335static RT_API_ATTRS
bool FormattedDerivedTypeIO(IoStatementState &io,
336 const Descriptor &descriptor,
const NonTbpDefinedIoTable *table) {
337 IoErrorHandler &handler{io.GetIoErrorHandler()};
339 const DescriptorAddendum *addendum{descriptor.Addendum()};
340 RUNTIME_CHECK(handler, addendum !=
nullptr);
341 const typeInfo::DerivedType *type{addendum->derivedType()};
342 RUNTIME_CHECK(handler, type !=
nullptr);
343 Fortran::common::optional<typeInfo::SpecialBinding> nonTbpSpecial;
344 const typeInfo::SpecialBinding *special{
nullptr};
346 if (
const auto *definedIo{table->Find(*type,
347 DIR == Direction::Input ? common::DefinedIo::ReadFormatted
348 : common::DefinedIo::WriteFormatted)}) {
349 if (definedIo->subroutine) {
350 nonTbpSpecial.emplace(DIR == Direction::Input
351 ? typeInfo::SpecialBinding::Which::ReadFormatted
352 : typeInfo::SpecialBinding::Which::WriteFormatted,
353 definedIo->subroutine, definedIo->isDtvArgPolymorphic,
false,
355 special = &*nonTbpSpecial;
360 if (
const typeInfo::SpecialBinding *
361 binding{type->FindSpecialBinding(DIR == Direction::Input
362 ? typeInfo::SpecialBinding::Which::ReadFormatted
363 : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
364 if (!table || !table->ignoreNonTbpEntries || binding->isTypeBound()) {
369 SubscriptValue subscripts[maxRank];
370 descriptor.GetLowerBounds(subscripts);
371 std::size_t numElements{descriptor.Elements()};
372 for (std::size_t j{0}; j < numElements;
373 ++j, descriptor.IncrementSubscripts(subscripts)) {
374 Fortran::common::optional<bool> result;
376 result = DefinedFormattedIo(io, descriptor, *type, *special, subscripts);
379 result = DefaultComponentwiseFormattedIO<DIR>(
380 io, descriptor, *type, table, subscripts);
382 if (!result.value()) {
385 io.get_if<ListDirectedStatementState<Direction::Input>>()};
386 return DIR == Direction::Input && j > 0 && listInput &&
387 listInput->inNamelistSequence();
393RT_API_ATTRS
bool DefinedUnformattedIo(IoStatementState &,
const Descriptor &,
394 const typeInfo::DerivedType &,
const typeInfo::SpecialBinding &);
397template <Direction DIR>
398static RT_API_ATTRS
bool UnformattedDescriptorIO(IoStatementState &io,
399 const Descriptor &descriptor,
const NonTbpDefinedIoTable *table =
nullptr) {
400 IoErrorHandler &handler{io.GetIoErrorHandler()};
401 const DescriptorAddendum *addendum{descriptor.Addendum()};
402 if (
const typeInfo::DerivedType *
403 type{addendum ? addendum->derivedType() :
nullptr}) {
406 if (
const auto *definedIo{table->Find(*type,
407 DIR == Direction::Input ? common::DefinedIo::ReadUnformatted
408 : common::DefinedIo::WriteUnformatted)}) {
409 if (definedIo->subroutine) {
410 typeInfo::SpecialBinding special{DIR == Direction::Input
411 ? typeInfo::SpecialBinding::Which::ReadUnformatted
412 : typeInfo::SpecialBinding::Which::WriteUnformatted,
413 definedIo->subroutine, definedIo->isDtvArgPolymorphic,
false,
415 if (Fortran::common::optional<bool> wasDefined{
416 DefinedUnformattedIo(io, descriptor, *type, special)}) {
420 return DefaultComponentwiseUnformattedIO<DIR>(
421 io, descriptor, *type, table);
425 if (
const typeInfo::SpecialBinding *
426 special{type->FindSpecialBinding(DIR == Direction::Input
427 ? typeInfo::SpecialBinding::Which::ReadUnformatted
428 : typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
429 if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) {
431 return DefinedUnformattedIo(io, descriptor, *type, *special);
438 return DefaultComponentwiseUnformattedIO<DIR>(io, descriptor, *type, table);
441 auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
442 auto *childUnf{io.get_if<ChildUnformattedIoStatementState<DIR>>()};
444 DIR == Direction::Output ? io.get_if<InquireIOLengthState>() :
nullptr};
445 RUNTIME_CHECK(handler, externalUnf || childUnf || inq);
446 std::size_t elementBytes{descriptor.ElementBytes()};
447 std::size_t numElements{descriptor.Elements()};
448 std::size_t swappingBytes{elementBytes};
449 if (
auto maybeCatAndKind{descriptor.type().GetCategoryAndKind()}) {
452 if (maybeCatAndKind->first == TypeCategory::Character) {
454 swappingBytes = maybeCatAndKind->second;
455 }
else if (maybeCatAndKind->first == TypeCategory::Complex) {
460 SubscriptValue subscripts[maxRank];
461 descriptor.GetLowerBounds(subscripts);
463 std::conditional_t<DIR == Direction::Output, const char, char>;
464 auto Transfer{[=](CharType &x, std::size_t totalBytes) ->
bool {
465 if constexpr (DIR == Direction::Output) {
466 return externalUnf ? externalUnf->Emit(&x, totalBytes, swappingBytes)
467 : childUnf ? childUnf->Emit(&x, totalBytes, swappingBytes)
468 : inq->Emit(&x, totalBytes, swappingBytes);
470 return externalUnf ? externalUnf->Receive(&x, totalBytes, swappingBytes)
471 : childUnf->Receive(&x, totalBytes, swappingBytes);
474 bool swapEndianness{externalUnf && externalUnf->unit().swapEndianness()};
475 if (!swapEndianness &&
476 descriptor.IsContiguous()) {
477 char &x{ExtractElement<char>(io, descriptor, subscripts)};
478 return Transfer(x, numElements * elementBytes);
480 for (std::size_t j{0}; j < numElements; ++j) {
481 char &x{ExtractElement<char>(io, descriptor, subscripts)};
482 if (!Transfer(x, elementBytes)) {
485 if (!descriptor.IncrementSubscripts(subscripts) &&
486 j + 1 < numElements) {
487 handler.Crash(
"DescriptorIO: subscripts out of bounds");
495template <Direction DIR>
496static RT_API_ATTRS
bool DescriptorIO(IoStatementState &io,
497 const Descriptor &descriptor,
const NonTbpDefinedIoTable *table) {
498 IoErrorHandler &handler{io.GetIoErrorHandler()};
499 if (handler.InError()) {
502 if (!io.get_if<IoDirectionState<DIR>>()) {
503 handler.Crash(
"DescriptorIO() called for wrong I/O direction");
506 if constexpr (DIR == Direction::Input) {
507 if (!io.BeginReadingRecord()) {
511 if (!io.get_if<FormattedIoStatementState<DIR>>()) {
512 return UnformattedDescriptorIO<DIR>(io, descriptor, table);
514 if (
auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
515 TypeCategory cat{catAndKind->first};
516 int kind{catAndKind->second};
518 case TypeCategory::Integer:
521 return FormattedIntegerIO<1, DIR>(io, descriptor,
true);
523 return FormattedIntegerIO<2, DIR>(io, descriptor,
true);
525 return FormattedIntegerIO<4, DIR>(io, descriptor,
true);
527 return FormattedIntegerIO<8, DIR>(io, descriptor,
true);
529 return FormattedIntegerIO<16, DIR>(io, descriptor,
true);
532 "not yet implemented: INTEGER(KIND=%d) in formatted IO", kind);
535 case TypeCategory::Unsigned:
538 return FormattedIntegerIO<1, DIR>(io, descriptor,
false);
540 return FormattedIntegerIO<2, DIR>(io, descriptor,
false);
542 return FormattedIntegerIO<4, DIR>(io, descriptor,
false);
544 return FormattedIntegerIO<8, DIR>(io, descriptor,
false);
546 return FormattedIntegerIO<16, DIR>(io, descriptor,
false);
549 "not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind);
552 case TypeCategory::Real:
555 return FormattedRealIO<2, DIR>(io, descriptor);
557 return FormattedRealIO<3, DIR>(io, descriptor);
559 return FormattedRealIO<4, DIR>(io, descriptor);
561 return FormattedRealIO<8, DIR>(io, descriptor);
563 return FormattedRealIO<10, DIR>(io, descriptor);
566 return FormattedRealIO<16, DIR>(io, descriptor);
569 "not yet implemented: REAL(KIND=%d) in formatted IO", kind);
572 case TypeCategory::Complex:
575 return FormattedComplexIO<2, DIR>(io, descriptor);
577 return FormattedComplexIO<3, DIR>(io, descriptor);
579 return FormattedComplexIO<4, DIR>(io, descriptor);
581 return FormattedComplexIO<8, DIR>(io, descriptor);
583 return FormattedComplexIO<10, DIR>(io, descriptor);
586 return FormattedComplexIO<16, DIR>(io, descriptor);
589 "not yet implemented: COMPLEX(KIND=%d) in formatted IO", kind);
592 case TypeCategory::Character:
595 return FormattedCharacterIO<char, DIR>(io, descriptor);
597 return FormattedCharacterIO<char16_t, DIR>(io, descriptor);
599 return FormattedCharacterIO<char32_t, DIR>(io, descriptor);
602 "not yet implemented: CHARACTER(KIND=%d) in formatted IO", kind);
605 case TypeCategory::Logical:
608 return FormattedLogicalIO<1, DIR>(io, descriptor);
610 return FormattedLogicalIO<2, DIR>(io, descriptor);
612 return FormattedLogicalIO<4, DIR>(io, descriptor);
614 return FormattedLogicalIO<8, DIR>(io, descriptor);
617 "not yet implemented: LOGICAL(KIND=%d) in formatted IO", kind);
620 case TypeCategory::Derived:
621 return FormattedDerivedTypeIO<DIR>(io, descriptor, table);
624 handler.Crash(
"DescriptorIO: bad type code (%d) in descriptor",
625 static_cast<int>(descriptor.type().raw()));