FLANG
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 "namelist.h"
21#include "terminator.h"
22#include "type-info.h"
23#include "unit.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"
28
29namespace Fortran::runtime::io::descr {
30template <typename A>
31inline RT_API_ATTRS A &ExtractElement(IoStatementState &io,
32 const Descriptor &descriptor, const SubscriptValue subscripts[]) {
33 A *p{descriptor.Element<A>(subscripts)};
34 if (!p) {
35 io.GetIoErrorHandler().Crash("Bad address for I/O item -- null base "
36 "address or subscripts out of range");
37 }
38 return *p;
39}
40
41// Per-category descriptor-based I/O templates
42
43// TODO (perhaps as a nontrivial but small starter project): implement
44// automatic repetition counts, like "10*3.14159", for list-directed and
45// NAMELIST array output.
46
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>;
54 bool anyInput{false};
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)) {
60 return false;
61 }
62 } else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
63 if (EditIntegerInput(
64 io, *edit, reinterpret_cast<void *>(&x), KIND, isSigned)) {
65 anyInput = true;
66 } else {
67 return anyInput && edit->IsNamelist();
68 }
69 }
70 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
71 io.GetIoErrorHandler().Crash(
72 "FormattedIntegerIO: subscripts out of bounds");
73 }
74 } else {
75 return false;
76 }
77 }
78 return true;
79}
80
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;
88 bool anyInput{false};
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)) {
94 return false;
95 }
96 } else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
97 if (EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) {
98 anyInput = true;
99 } else {
100 return anyInput && edit->IsNamelist();
101 }
102 }
103 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
104 io.GetIoErrorHandler().Crash(
105 "FormattedRealIO: subscripts out of bounds");
106 }
107 } else {
108 return false;
109 }
110 }
111 return true;
112}
113
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);
120 bool isListOutput{
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)};
126 if (isListOutput) {
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)) {
133 return false;
134 }
135 } else {
136 for (int k{0}; k < 2; ++k, ++x) {
137 auto edit{io.GetNextDataEdit()};
138 if (!edit) {
139 return false;
140 } else if constexpr (DIR == Direction::Output) {
141 if (!RealOutputEditing<KIND>{io, *x}.Edit(*edit)) {
142 return false;
143 }
144 } else if (edit->descriptor == DataEdit::ListDirectedNullValue) {
145 break;
146 } else if (EditRealInput<KIND>(
147 io, *edit, reinterpret_cast<void *>(x))) {
148 anyInput = true;
149 } else {
150 return anyInput && edit->IsNamelist();
151 }
152 }
153 }
154 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
155 io.GetIoErrorHandler().Crash(
156 "FormattedComplexIO: subscripts out of bounds");
157 }
158 }
159 return true;
160}
161
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)};
173 if (listOutput) {
174 if (!ListDirectedCharacterOutput(io, *listOutput, x, length)) {
175 return false;
176 }
177 } else if (auto edit{io.GetNextDataEdit()}) {
178 if constexpr (DIR == Direction::Output) {
179 if (!EditCharacterOutput(io, *edit, x, length)) {
180 return false;
181 }
182 } else { // input
183 if (edit->descriptor != DataEdit::ListDirectedNullValue) {
184 if (EditCharacterInput(io, *edit, x, length)) {
185 anyInput = true;
186 } else {
187 return anyInput && edit->IsNamelist();
188 }
189 }
190 }
191 } else {
192 return false;
193 }
194 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
195 io.GetIoErrorHandler().Crash(
196 "FormattedCharacterIO: subscripts out of bounds");
197 }
198 }
199 return true;
200}
201
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)};
213 if (listOutput) {
214 if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) {
215 return false;
216 }
217 } else if (auto edit{io.GetNextDataEdit()}) {
218 if constexpr (DIR == Direction::Output) {
219 if (!EditLogicalOutput(io, *edit, x != 0)) {
220 return false;
221 }
222 } else {
223 if (edit->descriptor != DataEdit::ListDirectedNullValue) {
224 bool truth{};
225 if (EditLogicalInput(io, *edit, truth)) {
226 x = truth;
227 anyInput = true;
228 } else {
229 return anyInput && edit->IsNamelist();
230 }
231 }
232 }
233 } else {
234 return false;
235 }
236 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
237 io.GetIoErrorHandler().Crash(
238 "FormattedLogicalIO: subscripts out of bounds");
239 }
240 }
241 return true;
242}
243
244template <Direction DIR>
245static RT_API_ATTRS bool DescriptorIO(IoStatementState &, const Descriptor &,
246 const NonTbpDefinedIoTable * = nullptr);
247
248// For intrinsic (not defined) derived type I/O, formatted & unformatted
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) {
256 // Create a descriptor for the component
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);
262 } else {
263 // Component is itself a descriptor
264 char *pointer{
265 origDescriptor.Element<char>(origSubscripts) + component.offset()};
266 RUNTIME_CHECK(
267 terminator, component.genre() == typeInfo::Component::Genre::Automatic);
268 const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)};
269 return DescriptorIO<DIR>(io, compDesc, table);
270 }
271#else
272 terminator.Crash("not yet implemented: component IO");
273#endif
274}
275
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)) {
292 // Return true for NAMELIST input if any component appeared.
293 auto *listInput{
294 io.get_if<ListDirectedStatementState<Direction::Input>>()};
295 return DIR == Direction::Input && k > 0 && listInput &&
296 listInput->inNamelistSequence();
297 }
298 }
299 return true;
300}
301
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)) {
323 return false;
324 }
325 }
326 }
327 return true;
328}
329
330RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
331 IoStatementState &, const Descriptor &, const typeInfo::DerivedType &,
332 const typeInfo::SpecialBinding &, const SubscriptValue[]);
333
334template <Direction DIR>
335static RT_API_ATTRS bool FormattedDerivedTypeIO(IoStatementState &io,
336 const Descriptor &descriptor, const NonTbpDefinedIoTable *table) {
337 IoErrorHandler &handler{io.GetIoErrorHandler()};
338 // Derived type information must be present for formatted I/O.
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};
345 if (table) {
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,
354 false);
355 special = &*nonTbpSpecial;
356 }
357 }
358 }
359 if (!special) {
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()) {
365 special = binding;
366 }
367 }
368 }
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;
375 if (special) {
376 result = DefinedFormattedIo(io, descriptor, *type, *special, subscripts);
377 }
378 if (!result) {
379 result = DefaultComponentwiseFormattedIO<DIR>(
380 io, descriptor, *type, table, subscripts);
381 }
382 if (!result.value()) {
383 // Return true for NAMELIST input if we got anything.
384 auto *listInput{
385 io.get_if<ListDirectedStatementState<Direction::Input>>()};
386 return DIR == Direction::Input && j > 0 && listInput &&
387 listInput->inNamelistSequence();
388 }
389 }
390 return true;
391}
392
393RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
394 const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
395
396// Unformatted I/O
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}) {
404 // derived type unformatted I/O
405 if (table) {
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,
414 false};
415 if (Fortran::common::optional<bool> wasDefined{
416 DefinedUnformattedIo(io, descriptor, *type, special)}) {
417 return *wasDefined;
418 }
419 } else {
420 return DefaultComponentwiseUnformattedIO<DIR>(
421 io, descriptor, *type, table);
422 }
423 }
424 }
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()) {
430 // defined derived type unformatted I/O
431 return DefinedUnformattedIo(io, descriptor, *type, *special);
432 }
433 }
434 // Default derived type unformatted I/O
435 // TODO: If no component at any level has defined READ or WRITE
436 // (as appropriate), the elements are contiguous, and no byte swapping
437 // is active, do a block transfer via the code below.
438 return DefaultComponentwiseUnformattedIO<DIR>(io, descriptor, *type, table);
439 } else {
440 // intrinsic type unformatted I/O
441 auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
442 auto *childUnf{io.get_if<ChildUnformattedIoStatementState<DIR>>()};
443 auto *inq{
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()}) {
450 // Byte swapping units can be smaller than elements, namely
451 // for COMPLEX and CHARACTER.
452 if (maybeCatAndKind->first == TypeCategory::Character) {
453 // swap each character position independently
454 swappingBytes = maybeCatAndKind->second; // kind
455 } else if (maybeCatAndKind->first == TypeCategory::Complex) {
456 // swap real and imaginary components independently
457 swappingBytes /= 2;
458 }
459 }
460 SubscriptValue subscripts[maxRank];
461 descriptor.GetLowerBounds(subscripts);
462 using CharType =
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);
469 } else {
470 return externalUnf ? externalUnf->Receive(&x, totalBytes, swappingBytes)
471 : childUnf->Receive(&x, totalBytes, swappingBytes);
472 }
473 }};
474 bool swapEndianness{externalUnf && externalUnf->unit().swapEndianness()};
475 if (!swapEndianness &&
476 descriptor.IsContiguous()) { // contiguous unformatted I/O
477 char &x{ExtractElement<char>(io, descriptor, subscripts)};
478 return Transfer(x, numElements * elementBytes);
479 } else { // non-contiguous or byte-swapped intrinsic type unformatted I/O
480 for (std::size_t j{0}; j < numElements; ++j) {
481 char &x{ExtractElement<char>(io, descriptor, subscripts)};
482 if (!Transfer(x, elementBytes)) {
483 return false;
484 }
485 if (!descriptor.IncrementSubscripts(subscripts) &&
486 j + 1 < numElements) {
487 handler.Crash("DescriptorIO: subscripts out of bounds");
488 }
489 }
490 return true;
491 }
492 }
493}
494
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()) {
500 return false;
501 }
502 if (!io.get_if<IoDirectionState<DIR>>()) {
503 handler.Crash("DescriptorIO() called for wrong I/O direction");
504 return false;
505 }
506 if constexpr (DIR == Direction::Input) {
507 if (!io.BeginReadingRecord()) {
508 return false;
509 }
510 }
511 if (!io.get_if<FormattedIoStatementState<DIR>>()) {
512 return UnformattedDescriptorIO<DIR>(io, descriptor, table);
513 }
514 if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
515 TypeCategory cat{catAndKind->first};
516 int kind{catAndKind->second};
517 switch (cat) {
518 case TypeCategory::Integer:
519 switch (kind) {
520 case 1:
521 return FormattedIntegerIO<1, DIR>(io, descriptor, true);
522 case 2:
523 return FormattedIntegerIO<2, DIR>(io, descriptor, true);
524 case 4:
525 return FormattedIntegerIO<4, DIR>(io, descriptor, true);
526 case 8:
527 return FormattedIntegerIO<8, DIR>(io, descriptor, true);
528 case 16:
529 return FormattedIntegerIO<16, DIR>(io, descriptor, true);
530 default:
531 handler.Crash(
532 "not yet implemented: INTEGER(KIND=%d) in formatted IO", kind);
533 return false;
534 }
535 case TypeCategory::Unsigned:
536 switch (kind) {
537 case 1:
538 return FormattedIntegerIO<1, DIR>(io, descriptor, false);
539 case 2:
540 return FormattedIntegerIO<2, DIR>(io, descriptor, false);
541 case 4:
542 return FormattedIntegerIO<4, DIR>(io, descriptor, false);
543 case 8:
544 return FormattedIntegerIO<8, DIR>(io, descriptor, false);
545 case 16:
546 return FormattedIntegerIO<16, DIR>(io, descriptor, false);
547 default:
548 handler.Crash(
549 "not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind);
550 return false;
551 }
552 case TypeCategory::Real:
553 switch (kind) {
554 case 2:
555 return FormattedRealIO<2, DIR>(io, descriptor);
556 case 3:
557 return FormattedRealIO<3, DIR>(io, descriptor);
558 case 4:
559 return FormattedRealIO<4, DIR>(io, descriptor);
560 case 8:
561 return FormattedRealIO<8, DIR>(io, descriptor);
562 case 10:
563 return FormattedRealIO<10, DIR>(io, descriptor);
564 // TODO: case double/double
565 case 16:
566 return FormattedRealIO<16, DIR>(io, descriptor);
567 default:
568 handler.Crash(
569 "not yet implemented: REAL(KIND=%d) in formatted IO", kind);
570 return false;
571 }
572 case TypeCategory::Complex:
573 switch (kind) {
574 case 2:
575 return FormattedComplexIO<2, DIR>(io, descriptor);
576 case 3:
577 return FormattedComplexIO<3, DIR>(io, descriptor);
578 case 4:
579 return FormattedComplexIO<4, DIR>(io, descriptor);
580 case 8:
581 return FormattedComplexIO<8, DIR>(io, descriptor);
582 case 10:
583 return FormattedComplexIO<10, DIR>(io, descriptor);
584 // TODO: case double/double
585 case 16:
586 return FormattedComplexIO<16, DIR>(io, descriptor);
587 default:
588 handler.Crash(
589 "not yet implemented: COMPLEX(KIND=%d) in formatted IO", kind);
590 return false;
591 }
592 case TypeCategory::Character:
593 switch (kind) {
594 case 1:
595 return FormattedCharacterIO<char, DIR>(io, descriptor);
596 case 2:
597 return FormattedCharacterIO<char16_t, DIR>(io, descriptor);
598 case 4:
599 return FormattedCharacterIO<char32_t, DIR>(io, descriptor);
600 default:
601 handler.Crash(
602 "not yet implemented: CHARACTER(KIND=%d) in formatted IO", kind);
603 return false;
604 }
605 case TypeCategory::Logical:
606 switch (kind) {
607 case 1:
608 return FormattedLogicalIO<1, DIR>(io, descriptor);
609 case 2:
610 return FormattedLogicalIO<2, DIR>(io, descriptor);
611 case 4:
612 return FormattedLogicalIO<4, DIR>(io, descriptor);
613 case 8:
614 return FormattedLogicalIO<8, DIR>(io, descriptor);
615 default:
616 handler.Crash(
617 "not yet implemented: LOGICAL(KIND=%d) in formatted IO", kind);
618 return false;
619 }
620 case TypeCategory::Derived:
621 return FormattedDerivedTypeIO<DIR>(io, descriptor, table);
622 }
623 }
624 handler.Crash("DescriptorIO: bad type code (%d) in descriptor",
625 static_cast<int>(descriptor.type().raw()));
626 return false;
627}
628} // namespace Fortran::runtime::io::descr
629#endif // FORTRAN_RUNTIME_DESCRIPTOR_IO_H_