1//===-- lib/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 FLANG_RT_RUNTIME_DESCRIPTOR_IO_H_
10#define FLANG_RT_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 "unit.h"
20#include "flang-rt/runtime/descriptor.h"
21#include "flang-rt/runtime/io-stmt.h"
22#include "flang-rt/runtime/namelist.h"
23#include "flang-rt/runtime/terminator.h"
24#include "flang-rt/runtime/type-info.h"
25#include "flang/Common/optional.h"
26#include "flang/Common/uint128.h"
27#include "flang/Runtime/cpp-type.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 const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)};
267 return compDesc.IsAllocated() && DescriptorIO<DIR>(io, compDesc, table);
268 }
269#else
270 terminator.Crash("not yet implemented: component IO");
271#endif
272}
273
274template <Direction DIR>
275static RT_API_ATTRS bool DefaultComponentwiseFormattedIO(IoStatementState &io,
276 const Descriptor &descriptor, const typeInfo::DerivedType &type,
277 const NonTbpDefinedIoTable *table, const SubscriptValue subscripts[]) {
278 IoErrorHandler &handler{io.GetIoErrorHandler()};
279 const Descriptor &compArray{type.component()};
280 RUNTIME_CHECK(handler, compArray.rank() == 1);
281 std::size_t numComponents{compArray.Elements()};
282 SubscriptValue at[maxRank];
283 compArray.GetLowerBounds(at);
284 for (std::size_t k{0}; k < numComponents;
285 ++k, compArray.IncrementSubscripts(at)) {
286 const typeInfo::Component &component{
287 *compArray.Element<typeInfo::Component>(at)};
288 if (!DefaultComponentIO<DIR>(
289 io, component, descriptor, subscripts, handler, table)) {
290 // Return true for NAMELIST input if any component appeared.
291 auto *listInput{
292 io.get_if<ListDirectedStatementState<Direction::Input>>()};
293 return DIR == Direction::Input && k > 0 && listInput &&
294 listInput->inNamelistSequence();
295 }
296 }
297 return true;
298}
299
300template <Direction DIR>
301static RT_API_ATTRS bool DefaultComponentwiseUnformattedIO(IoStatementState &io,
302 const Descriptor &descriptor, const typeInfo::DerivedType &type,
303 const NonTbpDefinedIoTable *table) {
304 IoErrorHandler &handler{io.GetIoErrorHandler()};
305 const Descriptor &compArray{type.component()};
306 RUNTIME_CHECK(handler, compArray.rank() == 1);
307 std::size_t numComponents{compArray.Elements()};
308 std::size_t numElements{descriptor.Elements()};
309 SubscriptValue subscripts[maxRank];
310 descriptor.GetLowerBounds(subscripts);
311 for (std::size_t j{0}; j < numElements;
312 ++j, descriptor.IncrementSubscripts(subscripts)) {
313 SubscriptValue at[maxRank];
314 compArray.GetLowerBounds(at);
315 for (std::size_t k{0}; k < numComponents;
316 ++k, compArray.IncrementSubscripts(at)) {
317 const typeInfo::Component &component{
318 *compArray.Element<typeInfo::Component>(at)};
319 if (!DefaultComponentIO<DIR>(
320 io, component, descriptor, subscripts, handler, table)) {
321 return false;
322 }
323 }
324 }
325 return true;
326}
327
328RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
329 IoStatementState &, const Descriptor &, const typeInfo::DerivedType &,
330 const typeInfo::SpecialBinding &, const SubscriptValue[]);
331
332template <Direction DIR>
333static RT_API_ATTRS bool FormattedDerivedTypeIO(IoStatementState &io,
334 const Descriptor &descriptor, const NonTbpDefinedIoTable *table) {
335 IoErrorHandler &handler{io.GetIoErrorHandler()};
336 // Derived type information must be present for formatted I/O.
337 const DescriptorAddendum *addendum{descriptor.Addendum()};
338 RUNTIME_CHECK(handler, addendum != nullptr);
339 const typeInfo::DerivedType *type{addendum->derivedType()};
340 RUNTIME_CHECK(handler, type != nullptr);
341 Fortran::common::optional<typeInfo::SpecialBinding> nonTbpSpecial;
342 const typeInfo::SpecialBinding *special{nullptr};
343 if (table) {
344 if (const auto *definedIo{table->Find(*type,
345 DIR == Direction::Input ? common::DefinedIo::ReadFormatted
346 : common::DefinedIo::WriteFormatted)}) {
347 if (definedIo->subroutine) {
348 nonTbpSpecial.emplace(DIR == Direction::Input
349 ? typeInfo::SpecialBinding::Which::ReadFormatted
350 : typeInfo::SpecialBinding::Which::WriteFormatted,
351 definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
352 false);
353 special = &*nonTbpSpecial;
354 }
355 }
356 }
357 if (!special) {
358 if (const typeInfo::SpecialBinding *
359 binding{type->FindSpecialBinding(DIR == Direction::Input
360 ? typeInfo::SpecialBinding::Which::ReadFormatted
361 : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
362 if (!table || !table->ignoreNonTbpEntries || binding->isTypeBound()) {
363 special = binding;
364 }
365 }
366 }
367 SubscriptValue subscripts[maxRank];
368 descriptor.GetLowerBounds(subscripts);
369 std::size_t numElements{descriptor.Elements()};
370 for (std::size_t j{0}; j < numElements;
371 ++j, descriptor.IncrementSubscripts(subscripts)) {
372 Fortran::common::optional<bool> result;
373 if (special) {
374 result = DefinedFormattedIo(io, descriptor, *type, *special, subscripts);
375 }
376 if (!result) {
377 result = DefaultComponentwiseFormattedIO<DIR>(
378 io, descriptor, *type, table, subscripts);
379 }
380 if (!result.value()) {
381 // Return true for NAMELIST input if we got anything.
382 auto *listInput{
383 io.get_if<ListDirectedStatementState<Direction::Input>>()};
384 return DIR == Direction::Input && j > 0 && listInput &&
385 listInput->inNamelistSequence();
386 }
387 }
388 return true;
389}
390
391RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
392 const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
393
394// Unformatted I/O
395template <Direction DIR>
396static RT_API_ATTRS bool UnformattedDescriptorIO(IoStatementState &io,
397 const Descriptor &descriptor, const NonTbpDefinedIoTable *table = nullptr) {
398 IoErrorHandler &handler{io.GetIoErrorHandler()};
399 const DescriptorAddendum *addendum{descriptor.Addendum()};
400 if (const typeInfo::DerivedType *
401 type{addendum ? addendum->derivedType() : nullptr}) {
402 // derived type unformatted I/O
403 if (table) {
404 if (const auto *definedIo{table->Find(*type,
405 DIR == Direction::Input ? common::DefinedIo::ReadUnformatted
406 : common::DefinedIo::WriteUnformatted)}) {
407 if (definedIo->subroutine) {
408 typeInfo::SpecialBinding special{DIR == Direction::Input
409 ? typeInfo::SpecialBinding::Which::ReadUnformatted
410 : typeInfo::SpecialBinding::Which::WriteUnformatted,
411 definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
412 false};
413 if (Fortran::common::optional<bool> wasDefined{
414 DefinedUnformattedIo(io, descriptor, *type, special)}) {
415 return *wasDefined;
416 }
417 } else {
418 return DefaultComponentwiseUnformattedIO<DIR>(
419 io, descriptor, *type, table);
420 }
421 }
422 }
423 if (const typeInfo::SpecialBinding *
424 special{type->FindSpecialBinding(DIR == Direction::Input
425 ? typeInfo::SpecialBinding::Which::ReadUnformatted
426 : typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
427 if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) {
428 // defined derived type unformatted I/O
429 return DefinedUnformattedIo(io, descriptor, *type, *special);
430 }
431 }
432 // Default derived type unformatted I/O
433 // TODO: If no component at any level has defined READ or WRITE
434 // (as appropriate), the elements are contiguous, and no byte swapping
435 // is active, do a block transfer via the code below.
436 return DefaultComponentwiseUnformattedIO<DIR>(io, descriptor, *type, table);
437 } else {
438 // intrinsic type unformatted I/O
439 auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
440 auto *childUnf{io.get_if<ChildUnformattedIoStatementState<DIR>>()};
441 auto *inq{
442 DIR == Direction::Output ? io.get_if<InquireIOLengthState>() : nullptr};
443 RUNTIME_CHECK(handler, externalUnf || childUnf || inq);
444 std::size_t elementBytes{descriptor.ElementBytes()};
445 std::size_t numElements{descriptor.Elements()};
446 std::size_t swappingBytes{elementBytes};
447 if (auto maybeCatAndKind{descriptor.type().GetCategoryAndKind()}) {
448 // Byte swapping units can be smaller than elements, namely
449 // for COMPLEX and CHARACTER.
450 if (maybeCatAndKind->first == TypeCategory::Character) {
451 // swap each character position independently
452 swappingBytes = maybeCatAndKind->second; // kind
453 } else if (maybeCatAndKind->first == TypeCategory::Complex) {
454 // swap real and imaginary components independently
455 swappingBytes /= 2;
456 }
457 }
458 SubscriptValue subscripts[maxRank];
459 descriptor.GetLowerBounds(subscripts);
460 using CharType =
461 std::conditional_t<DIR == Direction::Output, const char, char>;
462 auto Transfer{[=](CharType &x, std::size_t totalBytes) -> bool {
463 if constexpr (DIR == Direction::Output) {
464 return externalUnf ? externalUnf->Emit(&x, totalBytes, swappingBytes)
465 : childUnf ? childUnf->Emit(&x, totalBytes, swappingBytes)
466 : inq->Emit(&x, totalBytes, swappingBytes);
467 } else {
468 return externalUnf ? externalUnf->Receive(&x, totalBytes, swappingBytes)
469 : childUnf->Receive(&x, totalBytes, swappingBytes);
470 }
471 }};
472 bool swapEndianness{externalUnf && externalUnf->unit().swapEndianness()};
473 if (!swapEndianness &&
474 descriptor.IsContiguous()) { // contiguous unformatted I/O
475 char &x{ExtractElement<char>(io, descriptor, subscripts)};
476 return Transfer(x, numElements * elementBytes);
477 } else { // non-contiguous or byte-swapped intrinsic type unformatted I/O
478 for (std::size_t j{0}; j < numElements; ++j) {
479 char &x{ExtractElement<char>(io, descriptor, subscripts)};
480 if (!Transfer(x, elementBytes)) {
481 return false;
482 }
483 if (!descriptor.IncrementSubscripts(subscripts) &&
484 j + 1 < numElements) {
485 handler.Crash("DescriptorIO: subscripts out of bounds");
486 }
487 }
488 return true;
489 }
490 }
491}
492
493template <Direction DIR>
494static RT_API_ATTRS bool DescriptorIO(IoStatementState &io,
495 const Descriptor &descriptor, const NonTbpDefinedIoTable *table) {
496 IoErrorHandler &handler{io.GetIoErrorHandler()};
497 if (handler.InError()) {
498 return false;
499 }
500 if (!io.get_if<IoDirectionState<DIR>>()) {
501 handler.Crash("DescriptorIO() called for wrong I/O direction");
502 return false;
503 }
504 if constexpr (DIR == Direction::Input) {
505 if (!io.BeginReadingRecord()) {
506 return false;
507 }
508 }
509 if (!io.get_if<FormattedIoStatementState<DIR>>()) {
510 return UnformattedDescriptorIO<DIR>(io, descriptor, table);
511 }
512 if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
513 TypeCategory cat{catAndKind->first};
514 int kind{catAndKind->second};
515 switch (cat) {
516 case TypeCategory::Integer:
517 switch (kind) {
518 case 1:
519 return FormattedIntegerIO<1, DIR>(io, descriptor, true);
520 case 2:
521 return FormattedIntegerIO<2, DIR>(io, descriptor, true);
522 case 4:
523 return FormattedIntegerIO<4, DIR>(io, descriptor, true);
524 case 8:
525 return FormattedIntegerIO<8, DIR>(io, descriptor, true);
526 case 16:
527 return FormattedIntegerIO<16, DIR>(io, descriptor, true);
528 default:
529 handler.Crash(
530 "not yet implemented: INTEGER(KIND=%d) in formatted IO", kind);
531 return false;
532 }
533 case TypeCategory::Unsigned:
534 switch (kind) {
535 case 1:
536 return FormattedIntegerIO<1, DIR>(io, descriptor, false);
537 case 2:
538 return FormattedIntegerIO<2, DIR>(io, descriptor, false);
539 case 4:
540 return FormattedIntegerIO<4, DIR>(io, descriptor, false);
541 case 8:
542 return FormattedIntegerIO<8, DIR>(io, descriptor, false);
543 case 16:
544 return FormattedIntegerIO<16, DIR>(io, descriptor, false);
545 default:
546 handler.Crash(
547 "not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind);
548 return false;
549 }
550 case TypeCategory::Real:
551 switch (kind) {
552 case 2:
553 return FormattedRealIO<2, DIR>(io, descriptor);
554 case 3:
555 return FormattedRealIO<3, DIR>(io, descriptor);
556 case 4:
557 return FormattedRealIO<4, DIR>(io, descriptor);
558 case 8:
559 return FormattedRealIO<8, DIR>(io, descriptor);
560 case 10:
561 return FormattedRealIO<10, DIR>(io, descriptor);
562 // TODO: case double/double
563 case 16:
564 return FormattedRealIO<16, DIR>(io, descriptor);
565 default:
566 handler.Crash(
567 "not yet implemented: REAL(KIND=%d) in formatted IO", kind);
568 return false;
569 }
570 case TypeCategory::Complex:
571 switch (kind) {
572 case 2:
573 return FormattedComplexIO<2, DIR>(io, descriptor);
574 case 3:
575 return FormattedComplexIO<3, DIR>(io, descriptor);
576 case 4:
577 return FormattedComplexIO<4, DIR>(io, descriptor);
578 case 8:
579 return FormattedComplexIO<8, DIR>(io, descriptor);
580 case 10:
581 return FormattedComplexIO<10, DIR>(io, descriptor);
582 // TODO: case double/double
583 case 16:
584 return FormattedComplexIO<16, DIR>(io, descriptor);
585 default:
586 handler.Crash(
587 "not yet implemented: COMPLEX(KIND=%d) in formatted IO", kind);
588 return false;
589 }
590 case TypeCategory::Character:
591 switch (kind) {
592 case 1:
593 return FormattedCharacterIO<char, DIR>(io, descriptor);
594 case 2:
595 return FormattedCharacterIO<char16_t, DIR>(io, descriptor);
596 case 4:
597 return FormattedCharacterIO<char32_t, DIR>(io, descriptor);
598 default:
599 handler.Crash(
600 "not yet implemented: CHARACTER(KIND=%d) in formatted IO", kind);
601 return false;
602 }
603 case TypeCategory::Logical:
604 switch (kind) {
605 case 1:
606 return FormattedLogicalIO<1, DIR>(io, descriptor);
607 case 2:
608 return FormattedLogicalIO<2, DIR>(io, descriptor);
609 case 4:
610 return FormattedLogicalIO<4, DIR>(io, descriptor);
611 case 8:
612 return FormattedLogicalIO<8, DIR>(io, descriptor);
613 default:
614 handler.Crash(
615 "not yet implemented: LOGICAL(KIND=%d) in formatted IO", kind);
616 return false;
617 }
618 case TypeCategory::Derived:
619 return FormattedDerivedTypeIO<DIR>(io, descriptor, table);
620 }
621 }
622 handler.Crash("DescriptorIO: bad type code (%d) in descriptor",
623 static_cast<int>(descriptor.type().raw()));
624 return false;
625}
626} // namespace Fortran::runtime::io::descr
627#endif // FLANG_RT_RUNTIME_DESCRIPTOR_IO_H_
628

source code of flang-rt/lib/runtime/descriptor-io.h