875 lines · cpp
1//===-- lib/runtime/descriptor-io.cpp ---------------------------*- 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-exception6//7//===----------------------------------------------------------------------===//8 9#include "descriptor-io.h"10#include "edit-input.h"11#include "edit-output.h"12#include "unit.h"13#include "flang-rt/runtime/descriptor.h"14#include "flang-rt/runtime/io-stmt.h"15#include "flang-rt/runtime/namelist.h"16#include "flang-rt/runtime/terminator.h"17#include "flang-rt/runtime/type-info.h"18#include "flang-rt/runtime/work-queue.h"19#include "flang/Common/optional.h"20#include "flang/Common/restorer.h"21#include "flang/Common/uint128.h"22#include "flang/Runtime/cpp-type.h"23#include "flang/Runtime/freestanding-tools.h"24 25// Implementation of I/O data list item transfers based on descriptors.26// (All I/O items come through here so that the code is exercised for test;27// some scalar I/O data transfer APIs could be changed to bypass their use28// of descriptors in the future for better efficiency.)29 30namespace Fortran::runtime::io::descr {31RT_OFFLOAD_API_GROUP_BEGIN32 33template <typename A>34inline RT_API_ATTRS A &ExtractElement(IoStatementState &io,35 const Descriptor &descriptor, const SubscriptValue subscripts[]) {36 A *p{descriptor.Element<A>(subscripts)};37 if (!p) {38 io.GetIoErrorHandler().Crash("Bad address for I/O item -- null base "39 "address or subscripts out of range");40 }41 return *p;42}43 44// Defined formatted I/O (maybe)45static RT_API_ATTRS common::optional<bool> DefinedFormattedIo(46 IoStatementState &io, const Descriptor &descriptor,47 const typeInfo::DerivedType &derived,48 const typeInfo::SpecialBinding &special,49 const SubscriptValue subscripts[]) {50 // Look at the next data edit descriptor. If this is list-directed input,51 // the "maxRepeat=0" argument will prevent the input from advancing over an52 // initial '(' that shouldn't be consumed now as the start of a real part.53 // It also allows reaching EOF without crashing, since the EOF only matters54 // if a child READ is actually performed.55 common::optional<DataEdit> peek{io.GetNextDataEdit(/*maxRepeat=*/0)};56 if (peek &&57 (peek->descriptor == DataEdit::DefinedDerivedType ||58 peek->descriptor == DataEdit::ListDirected ||59 peek->descriptor == DataEdit::ListDirectedRealPart)) {60 // Defined formatting61 IoErrorHandler &handler{io.GetIoErrorHandler()};62 DataEdit edit{peek->descriptor == DataEdit::ListDirectedRealPart63 ? *peek64 : *io.GetNextDataEdit(1)};65 char ioType[2 + edit.maxIoTypeChars];66 auto ioTypeLen{std::size_t{2} /*"DT"*/ + edit.ioTypeChars};67 auto &definedIoArgs{*io.get_if<DefinedIoArgs>()};68 if (edit.descriptor == DataEdit::DefinedDerivedType) {69 ioType[0] = 'D';70 ioType[1] = 'T';71 runtime::memcpy(ioType + 2, definedIoArgs.ioType, edit.ioTypeChars);72 } else {73 runtime::strcpy(74 ioType, io.mutableModes().inNamelist ? "NAMELIST" : "LISTDIRECTED");75 ioTypeLen = runtime::strlen(ioType);76 }77 // V_LIST= argument78 StaticDescriptor<1, true> vListStatDesc;79 Descriptor &vListDesc{vListStatDesc.descriptor()};80 bool integer8{special.specialCaseFlag()};81 std::int64_t vList64[edit.maxVListEntries];82 if (integer8) {83 // Convert v_list values to INTEGER(8)84 for (int j{0}; j < edit.vListEntries; ++j) {85 vList64[j] = definedIoArgs.vList[j];86 }87 vListDesc.Establish(88 TypeCategory::Integer, sizeof(std::int64_t), nullptr, 1);89 vListDesc.set_base_addr(vList64);90 vListDesc.GetDimension(0).SetBounds(1, edit.vListEntries);91 vListDesc.GetDimension(0).SetByteStride(92 static_cast<SubscriptValue>(sizeof(std::int64_t)));93 } else {94 vListDesc.Establish(TypeCategory::Integer, sizeof(int), nullptr, 1);95 vListDesc.set_base_addr(definedIoArgs.vList);96 vListDesc.GetDimension(0).SetBounds(1, edit.vListEntries);97 vListDesc.GetDimension(0).SetByteStride(98 static_cast<SubscriptValue>(sizeof(int)));99 }100 ExternalFileUnit *actualExternal{io.GetExternalFileUnit()};101 ExternalFileUnit *external{actualExternal};102 if (!external) {103 // Create a new unit to service defined I/O for an104 // internal I/O parent.105 external = &ExternalFileUnit::NewUnit(handler, true);106 }107 ChildIo &child{external->PushChildIo(io)};108 // Child formatted I/O is nonadvancing by definition (F'2018 12.6.2.4).109 auto restorer{common::ScopedSet(io.mutableModes().nonAdvancing, true)};110 std::int32_t unit{external->unitNumber()};111 std::int32_t ioStat{IostatOk};112 char ioMsg[100];113 common::optional<std::int64_t> startPos;114 if (edit.descriptor == DataEdit::DefinedDerivedType &&115 special.which() == typeInfo::SpecialBinding::Which::ReadFormatted) {116 // DT is an edit descriptor, so everything that the child117 // I/O subroutine reads counts towards READ(SIZE=).118 startPos = io.InquirePos();119 }120 const auto *bindings{121 derived.binding().OffsetElement<const typeInfo::Binding>()};122 if (special.IsArgDescriptor(0)) {123 // "dtv" argument is "class(t)", pass a descriptor124 StaticDescriptor<1, true, 10 /*?*/> elementStatDesc;125 Descriptor &elementDesc{elementStatDesc.descriptor()};126 elementDesc.Establish(127 derived, nullptr, 0, nullptr, CFI_attribute_pointer);128 elementDesc.set_base_addr(descriptor.Element<char>(subscripts));129 if (integer8) { // 64-bit UNIT=/IOSTAT=130 std::int64_t unit64{unit};131 std::int64_t ioStat64{ioStat};132 auto *p{special.GetProc<void (*)(const Descriptor &, std::int64_t &,133 char *, const Descriptor &, std::int64_t &, char *, std::size_t,134 std::size_t)>(bindings)};135 p(elementDesc, unit64, ioType, vListDesc, ioStat64, ioMsg, ioTypeLen,136 sizeof ioMsg);137 ioStat = ioStat64;138 } else { // 32-bit UNIT=/IOSTAT=139 auto *p{special.GetProc<void (*)(const Descriptor &, std::int32_t &,140 char *, const Descriptor &, std::int32_t &, char *, std::size_t,141 std::size_t)>(bindings)};142 p(elementDesc, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,143 sizeof ioMsg);144 }145 } else {146 // "dtv" argument is "type(t)", pass a raw pointer147 if (integer8) { // 64-bit UNIT= and IOSTAT=148 std::int64_t unit64{unit};149 std::int64_t ioStat64{ioStat};150 auto *p{special.GetProc<void (*)(const void *, std::int64_t &, char *,151 const Descriptor &, std::int64_t &, char *, std::size_t,152 std::size_t)>(bindings)};153 p(descriptor.Element<char>(subscripts), unit64, ioType, vListDesc,154 ioStat64, ioMsg, ioTypeLen, sizeof ioMsg);155 ioStat = ioStat64;156 } else { // 32-bit UNIT= and IOSTAT=157 auto *p{special.GetProc<void (*)(const void *, std::int32_t &, char *,158 const Descriptor &, std::int32_t &, char *, std::size_t,159 std::size_t)>(bindings)};160 p(descriptor.Element<char>(subscripts), unit, ioType, vListDesc, ioStat,161 ioMsg, ioTypeLen, sizeof ioMsg);162 }163 }164 handler.Forward(ioStat, ioMsg, sizeof ioMsg);165 external->PopChildIo(child);166 if (!actualExternal) {167 // Close unit created for internal I/O above.168 auto *closing{external->LookUpForClose(external->unitNumber())};169 RUNTIME_CHECK(handler, external == closing);170 external->DestroyClosed();171 }172 if (startPos) {173 io.GotChar(io.InquirePos() - *startPos);174 }175 return handler.GetIoStat() == IostatOk;176 } else if (peek && peek->descriptor == DataEdit::ListDirectedNullValue) {177 return false;178 } else {179 // There's a defined I/O subroutine, but there's a FORMAT present and180 // it does not have a DT data edit descriptor, so apply default formatting181 // to the components of the derived type as usual.182 return common::nullopt;183 }184}185 186// Defined unformatted I/O187static RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &io,188 const Descriptor &descriptor, const typeInfo::DerivedType &derived,189 const typeInfo::SpecialBinding &special) {190 // Unformatted I/O must have an external unit (or child thereof).191 IoErrorHandler &handler{io.GetIoErrorHandler()};192 ExternalFileUnit *external{io.GetExternalFileUnit()};193 if (!external) { // INQUIRE(IOLENGTH=)194 handler.SignalError(IostatNonExternalDefinedUnformattedIo);195 return false;196 }197 ChildIo &child{external->PushChildIo(io)};198 int unit{external->unitNumber()};199 int ioStat{IostatOk};200 char ioMsg[100];201 std::size_t numElements{descriptor.Elements()};202 SubscriptValue subscripts[maxRank];203 descriptor.GetLowerBounds(subscripts);204 const auto *bindings{205 derived.binding().OffsetElement<const typeInfo::Binding>()};206 if (special.IsArgDescriptor(0)) {207 // "dtv" argument is "class(t)", pass a descriptor208 auto *p{special.GetProc<void (*)(209 const Descriptor &, int &, int &, char *, std::size_t)>(bindings)};210 StaticDescriptor<1, true, 10 /*?*/> elementStatDesc;211 Descriptor &elementDesc{elementStatDesc.descriptor()};212 elementDesc.Establish(derived, nullptr, 0, nullptr, CFI_attribute_pointer);213 for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {214 elementDesc.set_base_addr(descriptor.Element<char>(subscripts));215 p(elementDesc, unit, ioStat, ioMsg, sizeof ioMsg);216 if (ioStat != IostatOk) {217 break;218 }219 }220 } else {221 // "dtv" argument is "type(t)", pass a raw pointer222 auto *p{special223 .GetProc<void (*)(const void *, int &, int &, char *, std::size_t)>(224 bindings)};225 for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {226 p(descriptor.Element<char>(subscripts), unit, ioStat, ioMsg,227 sizeof ioMsg);228 if (ioStat != IostatOk) {229 break;230 }231 }232 }233 handler.Forward(ioStat, ioMsg, sizeof ioMsg);234 external->PopChildIo(child);235 return handler.GetIoStat() == IostatOk;236}237 238// Per-category descriptor-based I/O templates239 240// TODO (perhaps as a nontrivial but small starter project): implement241// automatic repetition counts, like "10*3.14159", for list-directed and242// NAMELIST array output.243 244template <int KIND, Direction DIR>245inline RT_API_ATTRS bool FormattedIntegerIO(IoStatementState &io,246 const Descriptor &descriptor, [[maybe_unused]] bool isSigned) {247 std::size_t numElements{descriptor.Elements()};248 SubscriptValue subscripts[maxRank];249 descriptor.GetLowerBounds(subscripts);250 using IntType = CppTypeFor<common::TypeCategory::Integer, KIND>;251 bool anyInput{false};252 for (std::size_t j{0}; j < numElements; ++j) {253 if (auto edit{io.GetNextDataEdit()}) {254 IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};255 if constexpr (DIR == Direction::Output) {256 if (!EditIntegerOutput<KIND>(io, *edit, x, isSigned)) {257 return false;258 }259 } else if (edit->descriptor != DataEdit::ListDirectedNullValue) {260 if (EditIntegerInput(261 io, *edit, reinterpret_cast<void *>(&x), KIND, isSigned)) {262 anyInput = true;263 } else {264 return anyInput && edit->IsNamelist();265 }266 }267 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {268 io.GetIoErrorHandler().Crash(269 "FormattedIntegerIO: subscripts out of bounds");270 }271 } else {272 return false;273 }274 }275 return true;276}277 278template <int KIND, Direction DIR>279inline RT_API_ATTRS bool FormattedRealIO(280 IoStatementState &io, const Descriptor &descriptor) {281 std::size_t numElements{descriptor.Elements()};282 SubscriptValue subscripts[maxRank];283 descriptor.GetLowerBounds(subscripts);284 using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;285 bool anyInput{false};286 for (std::size_t j{0}; j < numElements; ++j) {287 if (auto edit{io.GetNextDataEdit()}) {288 RawType &x{ExtractElement<RawType>(io, descriptor, subscripts)};289 if constexpr (DIR == Direction::Output) {290 if (!RealOutputEditing<KIND>{io, x}.Edit(*edit)) {291 return false;292 }293 } else if (edit->descriptor != DataEdit::ListDirectedNullValue) {294 if (EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) {295 anyInput = true;296 } else {297 return anyInput && edit->IsNamelist();298 }299 }300 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {301 io.GetIoErrorHandler().Crash(302 "FormattedRealIO: subscripts out of bounds");303 }304 } else {305 return false;306 }307 }308 return true;309}310 311template <int KIND, Direction DIR>312inline RT_API_ATTRS bool FormattedComplexIO(313 IoStatementState &io, const Descriptor &descriptor) {314 std::size_t numElements{descriptor.Elements()};315 SubscriptValue subscripts[maxRank];316 descriptor.GetLowerBounds(subscripts);317 bool isListOutput{318 io.get_if<ListDirectedStatementState<Direction::Output>>() != nullptr};319 using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;320 bool anyInput{false};321 for (std::size_t j{0}; j < numElements; ++j) {322 RawType *x{&ExtractElement<RawType>(io, descriptor, subscripts)};323 if (isListOutput) {324 DataEdit rEdit, iEdit;325 rEdit.descriptor = DataEdit::ListDirectedRealPart;326 iEdit.descriptor = DataEdit::ListDirectedImaginaryPart;327 rEdit.modes = iEdit.modes = io.mutableModes();328 if (!RealOutputEditing<KIND>{io, x[0]}.Edit(rEdit) ||329 !RealOutputEditing<KIND>{io, x[1]}.Edit(iEdit)) {330 return false;331 }332 } else {333 for (int k{0}; k < 2; ++k, ++x) {334 auto edit{io.GetNextDataEdit()};335 if (!edit) {336 return false;337 } else if constexpr (DIR == Direction::Output) {338 if (!RealOutputEditing<KIND>{io, *x}.Edit(*edit)) {339 return false;340 }341 } else if (edit->descriptor == DataEdit::ListDirectedNullValue) {342 break;343 } else if (EditRealInput<KIND>(344 io, *edit, reinterpret_cast<void *>(x))) {345 anyInput = true;346 } else {347 return anyInput && edit->IsNamelist();348 }349 }350 }351 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {352 io.GetIoErrorHandler().Crash(353 "FormattedComplexIO: subscripts out of bounds");354 }355 }356 return true;357}358 359template <typename A, Direction DIR>360inline RT_API_ATTRS bool FormattedCharacterIO(361 IoStatementState &io, const Descriptor &descriptor) {362 std::size_t numElements{descriptor.Elements()};363 SubscriptValue subscripts[maxRank];364 descriptor.GetLowerBounds(subscripts);365 std::size_t length{descriptor.ElementBytes() / sizeof(A)};366 auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};367 bool anyInput{false};368 for (std::size_t j{0}; j < numElements; ++j) {369 A *x{&ExtractElement<A>(io, descriptor, subscripts)};370 if (listOutput) {371 if (!ListDirectedCharacterOutput(io, *listOutput, x, length)) {372 return false;373 }374 } else if (auto edit{io.GetNextDataEdit()}) {375 if constexpr (DIR == Direction::Output) {376 if (!EditCharacterOutput(io, *edit, x, length)) {377 return false;378 }379 } else { // input380 if (edit->descriptor != DataEdit::ListDirectedNullValue) {381 if (EditCharacterInput(io, *edit, x, length)) {382 anyInput = true;383 } else {384 return anyInput && edit->IsNamelist();385 }386 }387 }388 } else {389 return false;390 }391 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {392 io.GetIoErrorHandler().Crash(393 "FormattedCharacterIO: subscripts out of bounds");394 }395 }396 return true;397}398 399template <int KIND, Direction DIR>400inline RT_API_ATTRS bool FormattedLogicalIO(401 IoStatementState &io, const Descriptor &descriptor) {402 std::size_t numElements{descriptor.Elements()};403 SubscriptValue subscripts[maxRank];404 descriptor.GetLowerBounds(subscripts);405 auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};406 using IntType = CppTypeFor<TypeCategory::Integer, KIND>;407 bool anyInput{false};408 for (std::size_t j{0}; j < numElements; ++j) {409 IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};410 if (listOutput) {411 if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) {412 return false;413 }414 } else if (auto edit{io.GetNextDataEdit()}) {415 if constexpr (DIR == Direction::Output) {416 if (!EditLogicalOutput(io, *edit, x != 0)) {417 return false;418 }419 } else {420 if (edit->descriptor != DataEdit::ListDirectedNullValue) {421 bool truth{};422 if (EditLogicalInput(io, *edit, truth)) {423 x = truth;424 anyInput = true;425 } else {426 return anyInput && edit->IsNamelist();427 }428 }429 }430 } else {431 return false;432 }433 if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {434 io.GetIoErrorHandler().Crash(435 "FormattedLogicalIO: subscripts out of bounds");436 }437 }438 return true;439}440 441template <Direction DIR>442RT_API_ATTRS int DerivedIoTicket<DIR>::Continue(WorkQueue &workQueue) {443 while (!IsComplete()) {444 if (component_->genre() == typeInfo::Component::Genre::Data) {445 // Create a descriptor for the component446 Descriptor &compDesc{componentDescriptor_.descriptor()};447 component_->CreatePointerDescriptor(448 compDesc, instance_, io_.GetIoErrorHandler(), subscripts_);449 Advance();450 if (int status{workQueue.BeginDescriptorIo<DIR>(451 io_, compDesc, table_, anyIoTookPlace_)};452 status != StatOk) {453 return status;454 }455 } else {456 // Component is itself a descriptor457 char *pointer{458 instance_.Element<char>(subscripts_) + component_->offset()};459 const Descriptor &compDesc{460 *reinterpret_cast<const Descriptor *>(pointer)};461 Advance();462 if (compDesc.IsAllocated()) {463 if (int status{workQueue.BeginDescriptorIo<DIR>(464 io_, compDesc, table_, anyIoTookPlace_)};465 status != StatOk) {466 return status;467 }468 }469 }470 }471 return StatOk;472}473 474template RT_API_ATTRS int DerivedIoTicket<Direction::Output>::Continue(475 WorkQueue &);476template RT_API_ATTRS int DerivedIoTicket<Direction::Input>::Continue(477 WorkQueue &);478 479template <Direction DIR>480RT_API_ATTRS int DescriptorIoTicket<DIR>::Begin(WorkQueue &workQueue) {481 IoErrorHandler &handler{io_.GetIoErrorHandler()};482 if (handler.InError()) {483 return handler.GetIoStat();484 }485 if (!io_.get_if<IoDirectionState<DIR>>()) {486 handler.Crash("DescriptorIO() called for wrong I/O direction");487 return handler.GetIoStat();488 }489 if constexpr (DIR == Direction::Input) {490 if (!io_.BeginReadingRecord()) {491 return StatOk;492 }493 }494 if (!io_.get_if<FormattedIoStatementState<DIR>>()) {495 // Unformatted I/O496 IoErrorHandler &handler{io_.GetIoErrorHandler()};497 const DescriptorAddendum *addendum{instance_.Addendum()};498 if (const typeInfo::DerivedType *type{499 addendum ? addendum->derivedType() : nullptr}) {500 // derived type unformatted I/O501 if (DIR == Direction::Input || !io_.get_if<InquireIOLengthState>()) {502 if (table_) {503 if (const auto *definedIo{table_->Find(*type,504 DIR == Direction::Input505 ? common::DefinedIo::ReadUnformatted506 : common::DefinedIo::WriteUnformatted)}) {507 if (definedIo->subroutine) {508 std::uint8_t isArgDescriptorSet{0};509 if (definedIo->flags & IsDtvArgPolymorphic) {510 isArgDescriptorSet = 1;511 }512 typeInfo::SpecialBinding special{DIR == Direction::Input513 ? typeInfo::SpecialBinding::Which::ReadUnformatted514 : typeInfo::SpecialBinding::Which::WriteUnformatted,515 definedIo->subroutine, isArgDescriptorSet,516 /*IsTypeBound=*/false,517 /*specialCaseFlag=*/!!(definedIo->flags & DefinedIoInteger8)};518 if (DefinedUnformattedIo(io_, instance_, *type, special)) {519 anyIoTookPlace_ = true;520 return StatOk;521 }522 } else {523 int status{workQueue.BeginDerivedIo<DIR>(524 io_, instance_, *type, table_, anyIoTookPlace_)};525 return status == StatContinue ? StatOk : status; // done here526 }527 }528 }529 if (const typeInfo::SpecialBinding *special{530 type->FindSpecialBinding(DIR == Direction::Input531 ? typeInfo::SpecialBinding::Which::ReadUnformatted532 : typeInfo::SpecialBinding::Which::WriteUnformatted)}) {533 if (!table_ || !table_->ignoreNonTbpEntries ||534 special->IsTypeBound()) {535 // defined derived type unformatted I/O536 if (DefinedUnformattedIo(io_, instance_, *type, *special)) {537 anyIoTookPlace_ = true;538 return StatOk;539 } else {540 return IostatEnd;541 }542 }543 }544 }545 // Default derived type unformatted I/O546 // TODO: If no component at any level has defined READ or WRITE547 // (as appropriate), the elements are contiguous, and no byte swapping548 // is active, do a block transfer via the code below.549 int status{workQueue.BeginDerivedIo<DIR>(550 io_, instance_, *type, table_, anyIoTookPlace_)};551 return status == StatContinue ? StatOk : status; // done here552 } else {553 // intrinsic type unformatted I/O554 auto *externalUnf{io_.get_if<ExternalUnformattedIoStatementState<DIR>>()};555 ChildUnformattedIoStatementState<DIR> *childUnf{nullptr};556 InquireIOLengthState *inq{nullptr};557 bool swapEndianness{false};558 if (externalUnf) {559 swapEndianness = externalUnf->unit().swapEndianness();560 } else {561 childUnf = io_.get_if<ChildUnformattedIoStatementState<DIR>>();562 if (!childUnf) {563 inq = DIR == Direction::Output ? io_.get_if<InquireIOLengthState>()564 : nullptr;565 RUNTIME_CHECK(handler, inq != nullptr);566 }567 }568 std::size_t elementBytes{instance_.ElementBytes()};569 std::size_t swappingBytes{elementBytes};570 if (auto maybeCatAndKind{instance_.type().GetCategoryAndKind()}) {571 // Byte swapping units can be smaller than elements, namely572 // for COMPLEX and CHARACTER.573 if (maybeCatAndKind->first == TypeCategory::Character) {574 // swap each character position independently575 swappingBytes = maybeCatAndKind->second; // kind576 } else if (maybeCatAndKind->first == TypeCategory::Complex) {577 // swap real and imaginary components independently578 swappingBytes /= 2;579 }580 }581 using CharType =582 std::conditional_t<DIR == Direction::Output, const char, char>;583 auto Transfer{[=](CharType &x, std::size_t totalBytes) -> bool {584 if constexpr (DIR == Direction::Output) {585 return externalUnf ? externalUnf->Emit(&x, totalBytes, swappingBytes)586 : childUnf ? childUnf->Emit(&x, totalBytes, swappingBytes)587 : inq->Emit(&x, totalBytes, swappingBytes);588 } else {589 return externalUnf590 ? externalUnf->Receive(&x, totalBytes, swappingBytes)591 : childUnf->Receive(&x, totalBytes, swappingBytes);592 }593 }};594 if (!swapEndianness &&595 instance_.IsContiguous()) { // contiguous unformatted I/O596 char &x{ExtractElement<char>(io_, instance_, subscripts_)};597 if (Transfer(x, elements_ * elementBytes)) {598 anyIoTookPlace_ = true;599 } else {600 return IostatEnd;601 }602 } else { // non-contiguous or byte-swapped intrinsic type unformatted I/O603 for (; !IsComplete(); Advance()) {604 char &x{ExtractElement<char>(io_, instance_, subscripts_)};605 if (Transfer(x, elementBytes)) {606 anyIoTookPlace_ = true;607 } else {608 return IostatEnd;609 }610 }611 }612 }613 // Unformatted I/O never needs to call Continue().614 return StatOk;615 }616 // Formatted I/O617 if (auto catAndKind{instance_.type().GetCategoryAndKind()}) {618 TypeCategory cat{catAndKind->first};619 int kind{catAndKind->second};620 bool any{false};621 switch (cat) {622 case TypeCategory::Integer:623 switch (kind) {624 case 1:625 any = FormattedIntegerIO<1, DIR>(io_, instance_, true);626 break;627 case 2:628 any = FormattedIntegerIO<2, DIR>(io_, instance_, true);629 break;630 case 4:631 any = FormattedIntegerIO<4, DIR>(io_, instance_, true);632 break;633 case 8:634 any = FormattedIntegerIO<8, DIR>(io_, instance_, true);635 break;636 case 16:637 any = FormattedIntegerIO<16, DIR>(io_, instance_, true);638 break;639 default:640 handler.Crash(641 "not yet implemented: INTEGER(KIND=%d) in formatted IO", kind);642 return IostatEnd;643 }644 break;645 case TypeCategory::Unsigned:646 switch (kind) {647 case 1:648 any = FormattedIntegerIO<1, DIR>(io_, instance_, false);649 break;650 case 2:651 any = FormattedIntegerIO<2, DIR>(io_, instance_, false);652 break;653 case 4:654 any = FormattedIntegerIO<4, DIR>(io_, instance_, false);655 break;656 case 8:657 any = FormattedIntegerIO<8, DIR>(io_, instance_, false);658 break;659 case 16:660 any = FormattedIntegerIO<16, DIR>(io_, instance_, false);661 break;662 default:663 handler.Crash(664 "not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind);665 return IostatEnd;666 }667 break;668 case TypeCategory::Real:669 switch (kind) {670 case 2:671 any = FormattedRealIO<2, DIR>(io_, instance_);672 break;673 case 3:674 any = FormattedRealIO<3, DIR>(io_, instance_);675 break;676 case 4:677 any = FormattedRealIO<4, DIR>(io_, instance_);678 break;679 case 8:680 any = FormattedRealIO<8, DIR>(io_, instance_);681 break;682 case 10:683 any = FormattedRealIO<10, DIR>(io_, instance_);684 break;685 // TODO: case double/double686 case 16:687 any = FormattedRealIO<16, DIR>(io_, instance_);688 break;689 default:690 handler.Crash(691 "not yet implemented: REAL(KIND=%d) in formatted IO", kind);692 return IostatEnd;693 }694 break;695 case TypeCategory::Complex:696 switch (kind) {697 case 2:698 any = FormattedComplexIO<2, DIR>(io_, instance_);699 break;700 case 3:701 any = FormattedComplexIO<3, DIR>(io_, instance_);702 break;703 case 4:704 any = FormattedComplexIO<4, DIR>(io_, instance_);705 break;706 case 8:707 any = FormattedComplexIO<8, DIR>(io_, instance_);708 break;709 case 10:710 any = FormattedComplexIO<10, DIR>(io_, instance_);711 break;712 // TODO: case double/double713 case 16:714 any = FormattedComplexIO<16, DIR>(io_, instance_);715 break;716 default:717 handler.Crash(718 "not yet implemented: COMPLEX(KIND=%d) in formatted IO", kind);719 return IostatEnd;720 }721 break;722 case TypeCategory::Character:723 switch (kind) {724 case 1:725 any = FormattedCharacterIO<char, DIR>(io_, instance_);726 break;727 case 2:728 any = FormattedCharacterIO<char16_t, DIR>(io_, instance_);729 break;730 case 4:731 any = FormattedCharacterIO<char32_t, DIR>(io_, instance_);732 break;733 default:734 handler.Crash(735 "not yet implemented: CHARACTER(KIND=%d) in formatted IO", kind);736 return IostatEnd;737 }738 break;739 case TypeCategory::Logical:740 switch (kind) {741 case 1:742 any = FormattedLogicalIO<1, DIR>(io_, instance_);743 break;744 case 2:745 any = FormattedLogicalIO<2, DIR>(io_, instance_);746 break;747 case 4:748 any = FormattedLogicalIO<4, DIR>(io_, instance_);749 break;750 case 8:751 any = FormattedLogicalIO<8, DIR>(io_, instance_);752 break;753 default:754 handler.Crash(755 "not yet implemented: LOGICAL(KIND=%d) in formatted IO", kind);756 return IostatEnd;757 }758 break;759 case TypeCategory::Derived: {760 // Derived type information must be present for formatted I/O.761 IoErrorHandler &handler{io_.GetIoErrorHandler()};762 const DescriptorAddendum *addendum{instance_.Addendum()};763 RUNTIME_CHECK(handler, addendum != nullptr);764 derived_ = addendum->derivedType();765 RUNTIME_CHECK(handler, derived_ != nullptr);766 if (table_) {767 if (const auto *definedIo{table_->Find(*derived_,768 DIR == Direction::Input ? common::DefinedIo::ReadFormatted769 : common::DefinedIo::WriteFormatted)}) {770 if (definedIo->subroutine) {771 nonTbpSpecial_.emplace(DIR == Direction::Input772 ? typeInfo::SpecialBinding::Which::ReadFormatted773 : typeInfo::SpecialBinding::Which::WriteFormatted,774 definedIo->subroutine,775 /*isArgDescriptorSet=*/776 (definedIo->flags & IsDtvArgPolymorphic) ? 1 : 0,777 /*isTypeBound=*/false,778 /*specialCaseFlag=*/!!(definedIo->flags & DefinedIoInteger8));779 special_ = &*nonTbpSpecial_;780 }781 }782 }783 if (!special_) {784 if (const typeInfo::SpecialBinding *binding{785 derived_->FindSpecialBinding(DIR == Direction::Input786 ? typeInfo::SpecialBinding::Which::ReadFormatted787 : typeInfo::SpecialBinding::Which::WriteFormatted)}) {788 if (!table_ || !table_->ignoreNonTbpEntries ||789 binding->IsTypeBound()) {790 special_ = binding;791 }792 }793 }794 return StatContinue;795 }796 }797 if (any) {798 anyIoTookPlace_ = true;799 } else {800 return IostatEnd;801 }802 } else {803 handler.Crash("DescriptorIO: bad type code (%d) in descriptor",804 static_cast<int>(instance_.type().raw()));805 return handler.GetIoStat();806 }807 return StatOk;808}809 810template RT_API_ATTRS int DescriptorIoTicket<Direction::Output>::Begin(811 WorkQueue &);812template RT_API_ATTRS int DescriptorIoTicket<Direction::Input>::Begin(813 WorkQueue &);814 815template <Direction DIR>816RT_API_ATTRS int DescriptorIoTicket<DIR>::Continue(WorkQueue &workQueue) {817 // Only derived type formatted I/O gets here.818 while (!IsComplete()) {819 if (special_) {820 if (auto defined{DefinedFormattedIo(821 io_, instance_, *derived_, *special_, subscripts_)}) {822 anyIoTookPlace_ |= *defined;823 Advance();824 continue;825 }826 }827 Descriptor &elementDesc{elementDescriptor_.descriptor()};828 elementDesc.Establish(829 *derived_, nullptr, 0, nullptr, CFI_attribute_pointer);830 elementDesc.set_base_addr(instance_.Element<char>(subscripts_));831 Advance();832 if (int status{workQueue.BeginDerivedIo<DIR>(833 io_, elementDesc, *derived_, table_, anyIoTookPlace_)};834 status != StatOk) {835 return status;836 }837 }838 return StatOk;839}840 841template RT_API_ATTRS int DescriptorIoTicket<Direction::Output>::Continue(842 WorkQueue &);843template RT_API_ATTRS int DescriptorIoTicket<Direction::Input>::Continue(844 WorkQueue &);845 846template <Direction DIR>847RT_API_ATTRS bool DescriptorIO(IoStatementState &io,848 const Descriptor &descriptor, const NonTbpDefinedIoTable *originalTable) {849 bool anyIoTookPlace{false};850 const NonTbpDefinedIoTable *defaultTable{io.nonTbpDefinedIoTable()};851 const NonTbpDefinedIoTable *table{originalTable};852 if (!table) {853 table = defaultTable;854 } else if (table != defaultTable) {855 io.set_nonTbpDefinedIoTable(table); // for nested I/O856 }857 WorkQueue workQueue{io.GetIoErrorHandler()};858 if (workQueue.BeginDescriptorIo<DIR>(io, descriptor, table, anyIoTookPlace) ==859 StatContinue) {860 workQueue.Run();861 }862 if (defaultTable != table) {863 io.set_nonTbpDefinedIoTable(defaultTable);864 }865 return anyIoTookPlace;866}867 868template RT_API_ATTRS bool DescriptorIO<Direction::Output>(869 IoStatementState &, const Descriptor &, const NonTbpDefinedIoTable *);870template RT_API_ATTRS bool DescriptorIO<Direction::Input>(871 IoStatementState &, const Descriptor &, const NonTbpDefinedIoTable *);872 873RT_OFFLOAD_API_GROUP_END874} // namespace Fortran::runtime::io::descr875