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 &(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( |
49 | IoStatementState &io, const Descriptor &descriptor) { |
50 | std::size_t numElements{descriptor.Elements()}; |
51 | SubscriptValue subscripts[maxRank]; |
52 | descriptor.GetLowerBounds(subscripts); |
53 | using IntType = CppTypeFor<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)) { |
60 | return false; |
61 | } |
62 | } else if (edit->descriptor != DataEdit::ListDirectedNullValue) { |
63 | if (EditIntegerInput(io, *edit, reinterpret_cast<void *>(&x), KIND)) { |
64 | anyInput = true; |
65 | } else { |
66 | return anyInput && edit->IsNamelist(); |
67 | } |
68 | } |
69 | if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { |
70 | io.GetIoErrorHandler().Crash( |
71 | "FormattedIntegerIO: subscripts out of bounds" ); |
72 | } |
73 | } else { |
74 | return false; |
75 | } |
76 | } |
77 | return true; |
78 | } |
79 | |
80 | template <int KIND, Direction DIR> |
81 | inline RT_API_ATTRS bool FormattedRealIO( |
82 | IoStatementState &io, const Descriptor &descriptor) { |
83 | std::size_t numElements{descriptor.Elements()}; |
84 | SubscriptValue subscripts[maxRank]; |
85 | descriptor.GetLowerBounds(subscripts); |
86 | using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint; |
87 | bool anyInput{false}; |
88 | for (std::size_t j{0}; j < numElements; ++j) { |
89 | if (auto edit{io.GetNextDataEdit()}) { |
90 | RawType &x{ExtractElement<RawType>(io, descriptor, subscripts)}; |
91 | if constexpr (DIR == Direction::Output) { |
92 | if (!RealOutputEditing<KIND>{io, x}.Edit(*edit)) { |
93 | return false; |
94 | } |
95 | } else if (edit->descriptor != DataEdit::ListDirectedNullValue) { |
96 | if (EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) { |
97 | anyInput = true; |
98 | } else { |
99 | return anyInput && edit->IsNamelist(); |
100 | } |
101 | } |
102 | if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { |
103 | io.GetIoErrorHandler().Crash( |
104 | "FormattedRealIO: subscripts out of bounds" ); |
105 | } |
106 | } else { |
107 | return false; |
108 | } |
109 | } |
110 | return true; |
111 | } |
112 | |
113 | template <int KIND, Direction DIR> |
114 | inline RT_API_ATTRS bool FormattedComplexIO( |
115 | IoStatementState &io, const Descriptor &descriptor) { |
116 | std::size_t numElements{descriptor.Elements()}; |
117 | SubscriptValue subscripts[maxRank]; |
118 | descriptor.GetLowerBounds(subscripts); |
119 | bool isListOutput{ |
120 | io.get_if<ListDirectedStatementState<Direction::Output>>() != nullptr}; |
121 | using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint; |
122 | bool anyInput{false}; |
123 | for (std::size_t j{0}; j < numElements; ++j) { |
124 | RawType *x{&ExtractElement<RawType>(io, descriptor, subscripts)}; |
125 | if (isListOutput) { |
126 | DataEdit rEdit, iEdit; |
127 | rEdit.descriptor = DataEdit::ListDirectedRealPart; |
128 | iEdit.descriptor = DataEdit::ListDirectedImaginaryPart; |
129 | rEdit.modes = iEdit.modes = io.mutableModes(); |
130 | if (!RealOutputEditing<KIND>{io, x[0]}.Edit(rEdit) || |
131 | !RealOutputEditing<KIND>{io, x[1]}.Edit(iEdit)) { |
132 | return false; |
133 | } |
134 | } else { |
135 | for (int k{0}; k < 2; ++k, ++x) { |
136 | auto edit{io.GetNextDataEdit()}; |
137 | if (!edit) { |
138 | return false; |
139 | } else if constexpr (DIR == Direction::Output) { |
140 | if (!RealOutputEditing<KIND>{io, *x}.Edit(*edit)) { |
141 | return false; |
142 | } |
143 | } else if (edit->descriptor == DataEdit::ListDirectedNullValue) { |
144 | break; |
145 | } else if (EditRealInput<KIND>( |
146 | io, *edit, reinterpret_cast<void *>(x))) { |
147 | anyInput = true; |
148 | } else { |
149 | return anyInput && edit->IsNamelist(); |
150 | } |
151 | } |
152 | } |
153 | if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { |
154 | io.GetIoErrorHandler().Crash( |
155 | "FormattedComplexIO: subscripts out of bounds" ); |
156 | } |
157 | } |
158 | return true; |
159 | } |
160 | |
161 | template <typename A, Direction DIR> |
162 | inline RT_API_ATTRS bool FormattedCharacterIO( |
163 | IoStatementState &io, const Descriptor &descriptor) { |
164 | std::size_t numElements{descriptor.Elements()}; |
165 | SubscriptValue subscripts[maxRank]; |
166 | descriptor.GetLowerBounds(subscripts); |
167 | std::size_t length{descriptor.ElementBytes() / sizeof(A)}; |
168 | auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()}; |
169 | bool anyInput{false}; |
170 | for (std::size_t j{0}; j < numElements; ++j) { |
171 | A *x{&ExtractElement<A>(io, descriptor, subscripts)}; |
172 | if (listOutput) { |
173 | if (!ListDirectedCharacterOutput(io, *listOutput, x, length)) { |
174 | return false; |
175 | } |
176 | } else if (auto edit{io.GetNextDataEdit()}) { |
177 | if constexpr (DIR == Direction::Output) { |
178 | if (!EditCharacterOutput(io, *edit, x, length)) { |
179 | return false; |
180 | } |
181 | } else { // input |
182 | if (edit->descriptor != DataEdit::ListDirectedNullValue) { |
183 | if (EditCharacterInput(io, *edit, x, length)) { |
184 | anyInput = true; |
185 | } else { |
186 | return anyInput && edit->IsNamelist(); |
187 | } |
188 | } |
189 | } |
190 | } else { |
191 | return false; |
192 | } |
193 | if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { |
194 | io.GetIoErrorHandler().Crash( |
195 | "FormattedCharacterIO: subscripts out of bounds" ); |
196 | } |
197 | } |
198 | return true; |
199 | } |
200 | |
201 | template <int KIND, Direction DIR> |
202 | inline RT_API_ATTRS bool FormattedLogicalIO( |
203 | IoStatementState &io, const Descriptor &descriptor) { |
204 | std::size_t numElements{descriptor.Elements()}; |
205 | SubscriptValue subscripts[maxRank]; |
206 | descriptor.GetLowerBounds(subscripts); |
207 | auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()}; |
208 | using IntType = CppTypeFor<TypeCategory::Integer, KIND>; |
209 | bool anyInput{false}; |
210 | for (std::size_t j{0}; j < numElements; ++j) { |
211 | IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)}; |
212 | if (listOutput) { |
213 | if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) { |
214 | return false; |
215 | } |
216 | } else if (auto edit{io.GetNextDataEdit()}) { |
217 | if constexpr (DIR == Direction::Output) { |
218 | if (!EditLogicalOutput(io, *edit, x != 0)) { |
219 | return false; |
220 | } |
221 | } else { |
222 | if (edit->descriptor != DataEdit::ListDirectedNullValue) { |
223 | bool truth{}; |
224 | if (EditLogicalInput(io, *edit, truth)) { |
225 | x = truth; |
226 | anyInput = true; |
227 | } else { |
228 | return anyInput && edit->IsNamelist(); |
229 | } |
230 | } |
231 | } |
232 | } else { |
233 | return false; |
234 | } |
235 | if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { |
236 | io.GetIoErrorHandler().Crash( |
237 | "FormattedLogicalIO: subscripts out of bounds" ); |
238 | } |
239 | } |
240 | return true; |
241 | } |
242 | |
243 | template <Direction DIR> |
244 | static RT_API_ATTRS bool DescriptorIO(IoStatementState &, const Descriptor &, |
245 | const NonTbpDefinedIoTable * = nullptr); |
246 | |
247 | // For intrinsic (not defined) derived type I/O, formatted & unformatted |
248 | template <Direction DIR> |
249 | static RT_API_ATTRS bool DefaultComponentIO(IoStatementState &io, |
250 | const typeInfo::Component &component, const Descriptor &origDescriptor, |
251 | const SubscriptValue origSubscripts[], Terminator &terminator, |
252 | const NonTbpDefinedIoTable *table) { |
253 | #if !defined(RT_DEVICE_AVOID_RECURSION) |
254 | if (component.genre() == typeInfo::Component::Genre::Data) { |
255 | // Create a descriptor for the component |
256 | StaticDescriptor<maxRank, true, 16 /*?*/> statDesc; |
257 | Descriptor &desc{statDesc.descriptor()}; |
258 | component.CreatePointerDescriptor( |
259 | desc, origDescriptor, terminator, origSubscripts); |
260 | return DescriptorIO<DIR>(io, desc, table); |
261 | } else { |
262 | // Component is itself a descriptor |
263 | char *pointer{ |
264 | origDescriptor.Element<char>(origSubscripts) + component.offset()}; |
265 | RUNTIME_CHECK( |
266 | terminator, component.genre() == typeInfo::Component::Genre::Automatic); |
267 | const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)}; |
268 | return DescriptorIO<DIR>(io, compDesc, table); |
269 | } |
270 | #else |
271 | terminator.Crash("not yet implemented: component IO" ); |
272 | #endif |
273 | } |
274 | |
275 | template <Direction DIR> |
276 | static RT_API_ATTRS bool DefaultComponentwiseFormattedIO(IoStatementState &io, |
277 | const Descriptor &descriptor, const typeInfo::DerivedType &type, |
278 | const NonTbpDefinedIoTable *table, const SubscriptValue subscripts[]) { |
279 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
280 | const Descriptor &compArray{type.component()}; |
281 | RUNTIME_CHECK(handler, compArray.rank() == 1); |
282 | std::size_t numComponents{compArray.Elements()}; |
283 | SubscriptValue at[maxRank]; |
284 | compArray.GetLowerBounds(at); |
285 | for (std::size_t k{0}; k < numComponents; |
286 | ++k, compArray.IncrementSubscripts(at)) { |
287 | const typeInfo::Component &component{ |
288 | *compArray.Element<typeInfo::Component>(at)}; |
289 | if (!DefaultComponentIO<DIR>( |
290 | io, component, descriptor, subscripts, handler, table)) { |
291 | // Return true for NAMELIST input if any component appeared. |
292 | auto *listInput{ |
293 | io.get_if<ListDirectedStatementState<Direction::Input>>()}; |
294 | return DIR == Direction::Input && k > 0 && listInput && |
295 | listInput->inNamelistSequence(); |
296 | } |
297 | } |
298 | return true; |
299 | } |
300 | |
301 | template <Direction DIR> |
302 | static RT_API_ATTRS bool DefaultComponentwiseUnformattedIO(IoStatementState &io, |
303 | const Descriptor &descriptor, const typeInfo::DerivedType &type, |
304 | const NonTbpDefinedIoTable *table) { |
305 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
306 | const Descriptor &compArray{type.component()}; |
307 | RUNTIME_CHECK(handler, compArray.rank() == 1); |
308 | std::size_t numComponents{compArray.Elements()}; |
309 | std::size_t numElements{descriptor.Elements()}; |
310 | SubscriptValue subscripts[maxRank]; |
311 | descriptor.GetLowerBounds(subscripts); |
312 | for (std::size_t j{0}; j < numElements; |
313 | ++j, descriptor.IncrementSubscripts(subscripts)) { |
314 | SubscriptValue at[maxRank]; |
315 | compArray.GetLowerBounds(at); |
316 | for (std::size_t k{0}; k < numComponents; |
317 | ++k, compArray.IncrementSubscripts(at)) { |
318 | const typeInfo::Component &component{ |
319 | *compArray.Element<typeInfo::Component>(at)}; |
320 | if (!DefaultComponentIO<DIR>( |
321 | io, component, descriptor, subscripts, handler, table)) { |
322 | return false; |
323 | } |
324 | } |
325 | } |
326 | return true; |
327 | } |
328 | |
329 | RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo( |
330 | IoStatementState &, const Descriptor &, const typeInfo::DerivedType &, |
331 | const typeInfo::SpecialBinding &, const SubscriptValue[]); |
332 | |
333 | template <Direction DIR> |
334 | static RT_API_ATTRS bool FormattedDerivedTypeIO(IoStatementState &io, |
335 | const Descriptor &descriptor, const NonTbpDefinedIoTable *table) { |
336 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
337 | // Derived type information must be present for formatted I/O. |
338 | const DescriptorAddendum *addendum{descriptor.Addendum()}; |
339 | RUNTIME_CHECK(handler, addendum != nullptr); |
340 | const typeInfo::DerivedType *type{addendum->derivedType()}; |
341 | RUNTIME_CHECK(handler, type != nullptr); |
342 | Fortran::common::optional<typeInfo::SpecialBinding> nonTbpSpecial; |
343 | const typeInfo::SpecialBinding *special{nullptr}; |
344 | if (table) { |
345 | if (const auto *definedIo{table->Find(*type, |
346 | DIR == Direction::Input ? common::DefinedIo::ReadFormatted |
347 | : common::DefinedIo::WriteFormatted)}) { |
348 | if (definedIo->subroutine) { |
349 | nonTbpSpecial.emplace(DIR == Direction::Input |
350 | ? typeInfo::SpecialBinding::Which::ReadFormatted |
351 | : typeInfo::SpecialBinding::Which::WriteFormatted, |
352 | definedIo->subroutine, definedIo->isDtvArgPolymorphic, false, |
353 | false); |
354 | special = &*nonTbpSpecial; |
355 | } |
356 | } |
357 | } |
358 | if (!special) { |
359 | if (const typeInfo::SpecialBinding * |
360 | binding{type->FindSpecialBinding(DIR == Direction::Input |
361 | ? typeInfo::SpecialBinding::Which::ReadFormatted |
362 | : typeInfo::SpecialBinding::Which::WriteFormatted)}) { |
363 | if (!table || !table->ignoreNonTbpEntries || binding->isTypeBound()) { |
364 | special = binding; |
365 | } |
366 | } |
367 | } |
368 | SubscriptValue subscripts[maxRank]; |
369 | descriptor.GetLowerBounds(subscripts); |
370 | std::size_t numElements{descriptor.Elements()}; |
371 | for (std::size_t j{0}; j < numElements; |
372 | ++j, descriptor.IncrementSubscripts(subscripts)) { |
373 | Fortran::common::optional<bool> result; |
374 | if (special) { |
375 | result = DefinedFormattedIo(io, descriptor, *type, *special, subscripts); |
376 | } |
377 | if (!result) { |
378 | result = DefaultComponentwiseFormattedIO<DIR>( |
379 | io, descriptor, *type, table, subscripts); |
380 | } |
381 | if (!result.value()) { |
382 | // Return true for NAMELIST input if we got anything. |
383 | auto *listInput{ |
384 | io.get_if<ListDirectedStatementState<Direction::Input>>()}; |
385 | return DIR == Direction::Input && j > 0 && listInput && |
386 | listInput->inNamelistSequence(); |
387 | } |
388 | } |
389 | return true; |
390 | } |
391 | |
392 | RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &, const Descriptor &, |
393 | const typeInfo::DerivedType &, const typeInfo::SpecialBinding &); |
394 | |
395 | // Unformatted I/O |
396 | template <Direction DIR> |
397 | static RT_API_ATTRS bool UnformattedDescriptorIO(IoStatementState &io, |
398 | const Descriptor &descriptor, const NonTbpDefinedIoTable *table = nullptr) { |
399 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
400 | const DescriptorAddendum *addendum{descriptor.Addendum()}; |
401 | if (const typeInfo::DerivedType * |
402 | type{addendum ? addendum->derivedType() : nullptr}) { |
403 | // derived type unformatted I/O |
404 | if (table) { |
405 | if (const auto *definedIo{table->Find(*type, |
406 | DIR == Direction::Input ? common::DefinedIo::ReadUnformatted |
407 | : common::DefinedIo::WriteUnformatted)}) { |
408 | if (definedIo->subroutine) { |
409 | typeInfo::SpecialBinding special{DIR == Direction::Input |
410 | ? typeInfo::SpecialBinding::Which::ReadUnformatted |
411 | : typeInfo::SpecialBinding::Which::WriteUnformatted, |
412 | definedIo->subroutine, definedIo->isDtvArgPolymorphic, false, |
413 | false}; |
414 | if (Fortran::common::optional<bool> wasDefined{ |
415 | DefinedUnformattedIo(io, descriptor, *type, special)}) { |
416 | return *wasDefined; |
417 | } |
418 | } else { |
419 | return DefaultComponentwiseUnformattedIO<DIR>( |
420 | io, descriptor, *type, table); |
421 | } |
422 | } |
423 | } |
424 | if (const typeInfo::SpecialBinding * |
425 | special{type->FindSpecialBinding(DIR == Direction::Input |
426 | ? typeInfo::SpecialBinding::Which::ReadUnformatted |
427 | : typeInfo::SpecialBinding::Which::WriteUnformatted)}) { |
428 | if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) { |
429 | // defined derived type unformatted I/O |
430 | return DefinedUnformattedIo(io, descriptor, *type, *special); |
431 | } |
432 | } |
433 | // Default derived type unformatted I/O |
434 | // TODO: If no component at any level has defined READ or WRITE |
435 | // (as appropriate), the elements are contiguous, and no byte swapping |
436 | // is active, do a block transfer via the code below. |
437 | return DefaultComponentwiseUnformattedIO<DIR>(io, descriptor, *type, table); |
438 | } else { |
439 | // intrinsic type unformatted I/O |
440 | auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()}; |
441 | auto *childUnf{io.get_if<ChildUnformattedIoStatementState<DIR>>()}; |
442 | auto *inq{ |
443 | DIR == Direction::Output ? io.get_if<InquireIOLengthState>() : nullptr}; |
444 | RUNTIME_CHECK(handler, externalUnf || childUnf || inq); |
445 | std::size_t elementBytes{descriptor.ElementBytes()}; |
446 | std::size_t numElements{descriptor.Elements()}; |
447 | std::size_t swappingBytes{elementBytes}; |
448 | if (auto maybeCatAndKind{descriptor.type().GetCategoryAndKind()}) { |
449 | // Byte swapping units can be smaller than elements, namely |
450 | // for COMPLEX and CHARACTER. |
451 | if (maybeCatAndKind->first == TypeCategory::Character) { |
452 | // swap each character position independently |
453 | swappingBytes = maybeCatAndKind->second; // kind |
454 | } else if (maybeCatAndKind->first == TypeCategory::Complex) { |
455 | // swap real and imaginary components independently |
456 | swappingBytes /= 2; |
457 | } |
458 | } |
459 | SubscriptValue subscripts[maxRank]; |
460 | descriptor.GetLowerBounds(subscripts); |
461 | using CharType = |
462 | std::conditional_t<DIR == Direction::Output, const char, char>; |
463 | auto Transfer{[=](CharType &x, std::size_t totalBytes) -> bool { |
464 | if constexpr (DIR == Direction::Output) { |
465 | return externalUnf ? externalUnf->Emit(&x, totalBytes, swappingBytes) |
466 | : childUnf ? childUnf->Emit(&x, totalBytes, swappingBytes) |
467 | : inq->Emit(&x, totalBytes, swappingBytes); |
468 | } else { |
469 | return externalUnf ? externalUnf->Receive(&x, totalBytes, swappingBytes) |
470 | : childUnf->Receive(&x, totalBytes, swappingBytes); |
471 | } |
472 | }}; |
473 | bool swapEndianness{externalUnf && externalUnf->unit().swapEndianness()}; |
474 | if (!swapEndianness && |
475 | descriptor.IsContiguous()) { // contiguous unformatted I/O |
476 | char &x{ExtractElement<char>(io, descriptor, subscripts)}; |
477 | return Transfer(x, numElements * elementBytes); |
478 | } else { // non-contiguous or byte-swapped intrinsic type unformatted I/O |
479 | for (std::size_t j{0}; j < numElements; ++j) { |
480 | char &x{ExtractElement<char>(io, descriptor, subscripts)}; |
481 | if (!Transfer(x, elementBytes)) { |
482 | return false; |
483 | } |
484 | if (!descriptor.IncrementSubscripts(subscripts) && |
485 | j + 1 < numElements) { |
486 | handler.Crash("DescriptorIO: subscripts out of bounds" ); |
487 | } |
488 | } |
489 | return true; |
490 | } |
491 | } |
492 | } |
493 | |
494 | template <Direction DIR> |
495 | static RT_API_ATTRS bool DescriptorIO(IoStatementState &io, |
496 | const Descriptor &descriptor, const NonTbpDefinedIoTable *table) { |
497 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
498 | if (handler.InError()) { |
499 | return false; |
500 | } |
501 | if (!io.get_if<IoDirectionState<DIR>>()) { |
502 | io.GetIoErrorHandler().Crash( |
503 | "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); |
522 | case 2: |
523 | return FormattedIntegerIO<2, DIR>(io, descriptor); |
524 | case 4: |
525 | return FormattedIntegerIO<4, DIR>(io, descriptor); |
526 | case 8: |
527 | return FormattedIntegerIO<8, DIR>(io, descriptor); |
528 | case 16: |
529 | return FormattedIntegerIO<16, DIR>(io, descriptor); |
530 | default: |
531 | handler.Crash( |
532 | "not yet implemented: INTEGER(KIND=%d) in formatted IO" , kind); |
533 | return false; |
534 | } |
535 | case TypeCategory::Real: |
536 | switch (kind) { |
537 | case 2: |
538 | return FormattedRealIO<2, DIR>(io, descriptor); |
539 | case 3: |
540 | return FormattedRealIO<3, DIR>(io, descriptor); |
541 | case 4: |
542 | return FormattedRealIO<4, DIR>(io, descriptor); |
543 | case 8: |
544 | return FormattedRealIO<8, DIR>(io, descriptor); |
545 | case 10: |
546 | return FormattedRealIO<10, DIR>(io, descriptor); |
547 | // TODO: case double/double |
548 | case 16: |
549 | return FormattedRealIO<16, DIR>(io, descriptor); |
550 | default: |
551 | handler.Crash( |
552 | "not yet implemented: REAL(KIND=%d) in formatted IO" , kind); |
553 | return false; |
554 | } |
555 | case TypeCategory::Complex: |
556 | switch (kind) { |
557 | case 2: |
558 | return FormattedComplexIO<2, DIR>(io, descriptor); |
559 | case 3: |
560 | return FormattedComplexIO<3, DIR>(io, descriptor); |
561 | case 4: |
562 | return FormattedComplexIO<4, DIR>(io, descriptor); |
563 | case 8: |
564 | return FormattedComplexIO<8, DIR>(io, descriptor); |
565 | case 10: |
566 | return FormattedComplexIO<10, DIR>(io, descriptor); |
567 | // TODO: case double/double |
568 | case 16: |
569 | return FormattedComplexIO<16, DIR>(io, descriptor); |
570 | default: |
571 | handler.Crash( |
572 | "not yet implemented: COMPLEX(KIND=%d) in formatted IO" , kind); |
573 | return false; |
574 | } |
575 | case TypeCategory::Character: |
576 | switch (kind) { |
577 | case 1: |
578 | return FormattedCharacterIO<char, DIR>(io, descriptor); |
579 | case 2: |
580 | return FormattedCharacterIO<char16_t, DIR>(io, descriptor); |
581 | case 4: |
582 | return FormattedCharacterIO<char32_t, DIR>(io, descriptor); |
583 | default: |
584 | handler.Crash( |
585 | "not yet implemented: CHARACTER(KIND=%d) in formatted IO" , kind); |
586 | return false; |
587 | } |
588 | case TypeCategory::Logical: |
589 | switch (kind) { |
590 | case 1: |
591 | return FormattedLogicalIO<1, DIR>(io, descriptor); |
592 | case 2: |
593 | return FormattedLogicalIO<2, DIR>(io, descriptor); |
594 | case 4: |
595 | return FormattedLogicalIO<4, DIR>(io, descriptor); |
596 | case 8: |
597 | return FormattedLogicalIO<8, DIR>(io, descriptor); |
598 | default: |
599 | handler.Crash( |
600 | "not yet implemented: LOGICAL(KIND=%d) in formatted IO" , kind); |
601 | return false; |
602 | } |
603 | case TypeCategory::Derived: |
604 | return FormattedDerivedTypeIO<DIR>(io, descriptor, table); |
605 | } |
606 | } |
607 | handler.Crash("DescriptorIO: bad type code (%d) in descriptor" , |
608 | static_cast<int>(descriptor.type().raw())); |
609 | return false; |
610 | } |
611 | } // namespace Fortran::runtime::io::descr |
612 | #endif // FORTRAN_RUNTIME_DESCRIPTOR_IO_H_ |
613 | |