xref: /llvm-project/flang/runtime/descriptor-io.h (revision fc97d2e68b03bc2979395e84b645e5b3ba35aecd)
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 
29 namespace Fortran::runtime::io::descr {
30 template <typename A>
31 inline 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 
47 template <int KIND, Direction DIR>
48 inline 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 
81 template <int KIND, Direction DIR>
82 inline 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 
114 template <int KIND, Direction DIR>
115 inline 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 
162 template <typename A, Direction DIR>
163 inline 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 
202 template <int KIND, Direction DIR>
203 inline 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 
244 template <Direction DIR>
245 static RT_API_ATTRS bool DescriptorIO(IoStatementState &, const Descriptor &,
246     const NonTbpDefinedIoTable * = nullptr);
247 
248 // For intrinsic (not defined) derived type I/O, formatted & unformatted
249 template <Direction DIR>
250 static 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 
276 template <Direction DIR>
277 static 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 
302 template <Direction DIR>
303 static 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 
330 RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
331     IoStatementState &, const Descriptor &, const typeInfo::DerivedType &,
332     const typeInfo::SpecialBinding &, const SubscriptValue[]);
333 
334 template <Direction DIR>
335 static 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 
393 RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
394     const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
395 
396 // Unformatted I/O
397 template <Direction DIR>
398 static 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 
495 template <Direction DIR>
496 static 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_
630