1324 lines · cpp
1//===-- lib/runtime/io-api.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// Implements the I/O statement API10 11// template function BeginExternalListIo<> is in runtime/io-api-common.h.12// APIs BeginExternalListOutput, OutputInteger{8,16,32,64,128},13// OutputReal{32,64}, OutputComplex{32,64}, OutputAscii, & EndIoStatement()14// are in runtime/io-api-minimal.cpp.15 16#include "flang/Runtime/io-api.h"17#include "descriptor-io.h"18#include "edit-input.h"19#include "edit-output.h"20#include "io-api-common.h"21#include "unit.h"22#include "flang-rt/runtime/descriptor.h"23#include "flang-rt/runtime/environment.h"24#include "flang-rt/runtime/format.h"25#include "flang-rt/runtime/io-stmt.h"26#include "flang-rt/runtime/memory.h"27#include "flang-rt/runtime/terminator.h"28#include "flang-rt/runtime/tools.h"29#include "flang/Common/optional.h"30#include <cstdlib>31#include <memory>32 33namespace Fortran::runtime::io {34RT_EXT_API_GROUP_BEGIN35 36template <Direction DIR>37RT_API_ATTRS Cookie BeginInternalArrayListIO(const Descriptor &descriptor,38 void ** /*scratchArea*/, std::size_t /*scratchBytes*/,39 const char *sourceFile, int sourceLine) {40 Terminator oom{sourceFile, sourceLine};41 return &New<InternalListIoStatementState<DIR>>{oom}(42 descriptor, sourceFile, sourceLine)43 .release()44 ->ioStatementState();45}46 47Cookie IODEF(BeginInternalArrayListOutput)(const Descriptor &descriptor,48 void **scratchArea, std::size_t scratchBytes, const char *sourceFile,49 int sourceLine) {50 return BeginInternalArrayListIO<Direction::Output>(51 descriptor, scratchArea, scratchBytes, sourceFile, sourceLine);52}53 54Cookie IODEF(BeginInternalArrayListInput)(const Descriptor &descriptor,55 void **scratchArea, std::size_t scratchBytes, const char *sourceFile,56 int sourceLine) {57 return BeginInternalArrayListIO<Direction::Input>(58 descriptor, scratchArea, scratchBytes, sourceFile, sourceLine);59}60 61template <Direction DIR>62RT_API_ATTRS Cookie BeginInternalArrayFormattedIO(const Descriptor &descriptor,63 const char *format, std::size_t formatLength,64 const Descriptor *formatDescriptor, void ** /*scratchArea*/,65 std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {66 Terminator oom{sourceFile, sourceLine};67 return &New<InternalFormattedIoStatementState<DIR>>{oom}(descriptor, format,68 formatLength, formatDescriptor, sourceFile, sourceLine)69 .release()70 ->ioStatementState();71}72 73Cookie IODEF(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,74 const char *format, std::size_t formatLength,75 const Descriptor *formatDescriptor, void **scratchArea,76 std::size_t scratchBytes, const char *sourceFile, int sourceLine) {77 return BeginInternalArrayFormattedIO<Direction::Output>(descriptor, format,78 formatLength, formatDescriptor, scratchArea, scratchBytes, sourceFile,79 sourceLine);80}81 82Cookie IODEF(BeginInternalArrayFormattedInput)(const Descriptor &descriptor,83 const char *format, std::size_t formatLength,84 const Descriptor *formatDescriptor, void **scratchArea,85 std::size_t scratchBytes, const char *sourceFile, int sourceLine) {86 return BeginInternalArrayFormattedIO<Direction::Input>(descriptor, format,87 formatLength, formatDescriptor, scratchArea, scratchBytes, sourceFile,88 sourceLine);89}90 91template <Direction DIR>92RT_API_ATTRS Cookie BeginInternalListIO(93 std::conditional_t<DIR == Direction::Input, const char, char> *internal,94 std::size_t internalLength, void ** /*scratchArea*/,95 std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {96 Terminator oom{sourceFile, sourceLine};97 return &New<InternalListIoStatementState<DIR>>{oom}(98 internal, internalLength, sourceFile, sourceLine)99 .release()100 ->ioStatementState();101}102 103Cookie IODEF(BeginInternalListOutput)(char *internal,104 std::size_t internalLength, void **scratchArea, std::size_t scratchBytes,105 const char *sourceFile, int sourceLine) {106 return BeginInternalListIO<Direction::Output>(internal, internalLength,107 scratchArea, scratchBytes, sourceFile, sourceLine);108}109 110Cookie IODEF(BeginInternalListInput)(const char *internal,111 std::size_t internalLength, void **scratchArea, std::size_t scratchBytes,112 const char *sourceFile, int sourceLine) {113 return BeginInternalListIO<Direction::Input>(internal, internalLength,114 scratchArea, scratchBytes, sourceFile, sourceLine);115}116 117template <Direction DIR>118RT_API_ATTRS Cookie BeginInternalFormattedIO(119 std::conditional_t<DIR == Direction::Input, const char, char> *internal,120 std::size_t internalLength, const char *format, std::size_t formatLength,121 const Descriptor *formatDescriptor, void ** /*scratchArea*/,122 std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {123 Terminator oom{sourceFile, sourceLine};124 return &New<InternalFormattedIoStatementState<DIR>>{oom}(internal,125 internalLength, format, formatLength, formatDescriptor, sourceFile,126 sourceLine)127 .release()128 ->ioStatementState();129}130 131Cookie IODEF(BeginInternalFormattedOutput)(char *internal,132 std::size_t internalLength, const char *format, std::size_t formatLength,133 const Descriptor *formatDescriptor, void **scratchArea,134 std::size_t scratchBytes, const char *sourceFile, int sourceLine) {135 return BeginInternalFormattedIO<Direction::Output>(internal, internalLength,136 format, formatLength, formatDescriptor, scratchArea, scratchBytes,137 sourceFile, sourceLine);138}139 140Cookie IODEF(BeginInternalFormattedInput)(const char *internal,141 std::size_t internalLength, const char *format, std::size_t formatLength,142 const Descriptor *formatDescriptor, void **scratchArea,143 std::size_t scratchBytes, const char *sourceFile, int sourceLine) {144 return BeginInternalFormattedIO<Direction::Input>(internal, internalLength,145 format, formatLength, formatDescriptor, scratchArea, scratchBytes,146 sourceFile, sourceLine);147}148 149Cookie IODEF(BeginExternalListInput)(150 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {151 return BeginExternalListIO<Direction::Input, ExternalListIoStatementState>(152 unitNumber, sourceFile, sourceLine);153}154 155template <Direction DIR>156RT_API_ATTRS Cookie BeginExternalFormattedIO(const char *format,157 std::size_t formatLength, const Descriptor *formatDescriptor,158 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {159 Terminator terminator{sourceFile, sourceLine};160 Cookie errorCookie{nullptr};161 ExternalFileUnit *unit{GetOrCreateUnit(162 unitNumber, DIR, false /*!unformatted*/, terminator, errorCookie)};163 if (!unit) {164 return errorCookie;165 }166 Iostat iostat{IostatOk};167 if (!unit->isUnformatted.has_value()) {168 unit->isUnformatted = false;169 }170 if (*unit->isUnformatted) {171 iostat = IostatFormattedIoOnUnformattedUnit;172 }173 if (ChildIo * child{unit->GetChildIo()}) {174 if (iostat == IostatOk) {175 iostat = child->CheckFormattingAndDirection(false, DIR);176 }177 if (iostat == IostatOk) {178 return &child->BeginIoStatement<ChildFormattedIoStatementState<DIR>>(179 *child, format, formatLength, formatDescriptor, sourceFile,180 sourceLine);181 } else {182 return &child->BeginIoStatement<ErroneousIoStatementState>(183 iostat, nullptr /* no unit */, sourceFile, sourceLine);184 }185 } else {186 if (iostat == IostatOk) {187 iostat = unit->SetDirection(DIR);188 }189 if (iostat == IostatOk) {190 return &unit->BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(191 terminator, *unit, format, formatLength, formatDescriptor, sourceFile,192 sourceLine);193 } else {194 return &unit->BeginIoStatement<ErroneousIoStatementState>(195 terminator, iostat, unit, sourceFile, sourceLine);196 }197 }198}199 200Cookie IODEF(BeginExternalFormattedOutput)(const char *format,201 std::size_t formatLength, const Descriptor *formatDescriptor,202 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {203 return BeginExternalFormattedIO<Direction::Output>(format, formatLength,204 formatDescriptor, unitNumber, sourceFile, sourceLine);205}206 207Cookie IODEF(BeginExternalFormattedInput)(const char *format,208 std::size_t formatLength, const Descriptor *formatDescriptor,209 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {210 return BeginExternalFormattedIO<Direction::Input>(format, formatLength,211 formatDescriptor, unitNumber, sourceFile, sourceLine);212}213 214template <Direction DIR>215RT_API_ATTRS Cookie BeginUnformattedIO(216 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {217 Terminator terminator{sourceFile, sourceLine};218 Cookie errorCookie{nullptr};219 ExternalFileUnit *unit{GetOrCreateUnit(220 unitNumber, DIR, true /*unformatted*/, terminator, errorCookie)};221 if (!unit) {222 return errorCookie;223 }224 Iostat iostat{IostatOk};225 if (!unit->isUnformatted.has_value()) {226 unit->isUnformatted = true;227 }228 if (!*unit->isUnformatted) {229 iostat = IostatUnformattedIoOnFormattedUnit;230 }231 if (ChildIo * child{unit->GetChildIo()}) {232 if (iostat == IostatOk) {233 iostat = child->CheckFormattingAndDirection(true, DIR);234 }235 if (iostat == IostatOk) {236 return &child->BeginIoStatement<ChildUnformattedIoStatementState<DIR>>(237 *child, sourceFile, sourceLine);238 } else {239 return &child->BeginIoStatement<ErroneousIoStatementState>(240 iostat, nullptr /* no unit */, sourceFile, sourceLine);241 }242 } else {243 if (iostat == IostatOk) {244 iostat = unit->SetDirection(DIR);245 }246 if (iostat == IostatOk) {247 IoStatementState &io{248 unit->BeginIoStatement<ExternalUnformattedIoStatementState<DIR>>(249 terminator, *unit, sourceFile, sourceLine)};250 if constexpr (DIR == Direction::Output) {251 if (unit->access == Access::Sequential) {252 // Create space for (sub)record header to be completed by253 // ExternalFileUnit::AdvanceRecord()254 unit->recordLength.reset(); // in case of prior BACKSPACE255 io.Emit("\0\0\0\0", 4); // placeholder for record length header256 }257 }258 return &io;259 } else {260 return &unit->BeginIoStatement<ErroneousIoStatementState>(261 terminator, iostat, unit, sourceFile, sourceLine);262 }263 }264}265 266Cookie IODEF(BeginUnformattedOutput)(267 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {268 return BeginUnformattedIO<Direction::Output>(269 unitNumber, sourceFile, sourceLine);270}271 272Cookie IODEF(BeginUnformattedInput)(273 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {274 return BeginUnformattedIO<Direction::Input>(275 unitNumber, sourceFile, sourceLine);276}277 278Cookie IODEF(BeginOpenUnit)( // OPEN(without NEWUNIT=)279 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {280 Terminator terminator{sourceFile, sourceLine};281 bool wasExtant{false};282 if (ExternalFileUnit *283 unit{ExternalFileUnit::LookUpOrCreate(284 unitNumber, terminator, wasExtant)}) {285 if (ChildIo * child{unit->GetChildIo()}) {286 return &child->BeginIoStatement<ErroneousIoStatementState>(287 IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,288 sourceLine);289 } else {290 return &unit->BeginIoStatement<OpenStatementState>(terminator, *unit,291 wasExtant, false /*not NEWUNIT=*/, sourceFile, sourceLine);292 }293 } else {294 return NoopUnit(terminator, unitNumber, IostatBadUnitNumber);295 }296}297 298Cookie IODEF(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)299 const char *sourceFile, int sourceLine) {300 Terminator terminator{sourceFile, sourceLine};301 ExternalFileUnit &unit{302 ExternalFileUnit::NewUnit(terminator, false /*not child I/O*/)};303 return &unit.BeginIoStatement<OpenStatementState>(terminator, unit,304 false /*was an existing file*/, true /*NEWUNIT=*/, sourceFile,305 sourceLine);306}307 308Cookie IODEF(BeginWait)(ExternalUnit unitNumber, AsynchronousId id,309 const char *sourceFile, int sourceLine) {310 Terminator terminator{sourceFile, sourceLine};311 if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {312 if (unit->Wait(id)) {313 return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,314 *unit, ExternalMiscIoStatementState::Wait, sourceFile, sourceLine);315 } else {316 return &unit->BeginIoStatement<ErroneousIoStatementState>(317 terminator, IostatBadWaitId, unit, sourceFile, sourceLine);318 }319 } else {320 return NoopUnit(321 terminator, unitNumber, id == 0 ? IostatOk : IostatBadWaitUnit);322 }323}324Cookie IODEF(BeginWaitAll)(325 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {326 return IONAME(BeginWait)(unitNumber, 0 /*no ID=*/, sourceFile, sourceLine);327}328 329Cookie IODEF(BeginClose)(330 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {331 Terminator terminator{sourceFile, sourceLine};332 if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {333 if (ChildIo * child{unit->GetChildIo()}) {334 return &child->BeginIoStatement<ErroneousIoStatementState>(335 IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,336 sourceLine);337 }338 }339 if (ExternalFileUnit * unit{ExternalFileUnit::LookUpForClose(unitNumber)}) {340 return &unit->BeginIoStatement<CloseStatementState>(341 terminator, *unit, sourceFile, sourceLine);342 } else {343 // CLOSE(UNIT=bad unit) is just a no-op344 return NoopUnit(terminator, unitNumber);345 }346}347 348Cookie IODEF(BeginFlush)(349 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {350 Terminator terminator{sourceFile, sourceLine};351 if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {352 if (ChildIo * child{unit->GetChildIo()}) {353 return &child->BeginIoStatement<ExternalMiscIoStatementState>(354 *unit, ExternalMiscIoStatementState::Flush, sourceFile, sourceLine);355 } else {356 return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,357 *unit, ExternalMiscIoStatementState::Flush, sourceFile, sourceLine);358 }359 } else {360 // FLUSH(UNIT=bad unit) is an error; an unconnected unit is a no-op361 return NoopUnit(terminator, unitNumber,362 unitNumber >= 0 ? IostatOk : IostatBadFlushUnit);363 }364}365 366Cookie IODEF(BeginBackspace)(367 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {368 Terminator terminator{sourceFile, sourceLine};369 if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {370 if (ChildIo * child{unit->GetChildIo()}) {371 return &child->BeginIoStatement<ErroneousIoStatementState>(372 IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,373 sourceLine);374 } else {375 return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,376 *unit, ExternalMiscIoStatementState::Backspace, sourceFile,377 sourceLine);378 }379 } else {380 return NoopUnit(terminator, unitNumber, IostatBadBackspaceUnit);381 }382}383 384Cookie IODEF(BeginEndfile)(385 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {386 Terminator terminator{sourceFile, sourceLine};387 Cookie errorCookie{nullptr};388 if (ExternalFileUnit *389 unit{GetOrCreateUnit(unitNumber, Direction::Output, common::nullopt,390 terminator, errorCookie)}) {391 if (ChildIo * child{unit->GetChildIo()}) {392 return &child->BeginIoStatement<ErroneousIoStatementState>(393 IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,394 sourceLine);395 } else {396 return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,397 *unit, ExternalMiscIoStatementState::Endfile, sourceFile, sourceLine);398 }399 } else {400 return errorCookie;401 }402}403 404Cookie IODEF(BeginRewind)(405 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {406 Terminator terminator{sourceFile, sourceLine};407 Cookie errorCookie{nullptr};408 if (ExternalFileUnit *409 unit{GetOrCreateUnit(unitNumber, Direction::Input, common::nullopt,410 terminator, errorCookie)}) {411 if (ChildIo * child{unit->GetChildIo()}) {412 return &child->BeginIoStatement<ErroneousIoStatementState>(413 IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,414 sourceLine);415 } else {416 return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,417 *unit, ExternalMiscIoStatementState::Rewind, sourceFile, sourceLine);418 }419 } else {420 return errorCookie;421 }422}423 424Cookie IODEF(BeginInquireUnit)(425 ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {426 Terminator terminator{sourceFile, sourceLine};427 if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {428 if (ChildIo * child{unit->GetChildIo()}) {429 return &child->BeginIoStatement<InquireUnitState>(430 *unit, sourceFile, sourceLine);431 } else {432 return &unit->BeginIoStatement<InquireUnitState>(433 terminator, *unit, sourceFile, sourceLine);434 }435 } else {436 // INQUIRE(UNIT=unrecognized unit)437 return &New<InquireNoUnitState>{terminator}(438 sourceFile, sourceLine, unitNumber)439 .release()440 ->ioStatementState();441 }442}443 444Cookie IODEF(BeginInquireFile)(const char *path, std::size_t pathLength,445 const char *sourceFile, int sourceLine) {446 Terminator terminator{sourceFile, sourceLine};447 auto trimmed{SaveDefaultCharacter(448 path, TrimTrailingSpaces(path, pathLength), terminator)};449 if (ExternalFileUnit *450 unit{ExternalFileUnit::LookUp(451 trimmed.get(), Fortran::runtime::strlen(trimmed.get()))}) {452 // INQUIRE(FILE=) to a connected unit453 if (ChildIo * child{unit->GetChildIo()}) {454 return &child->BeginIoStatement<InquireUnitState>(455 *unit, sourceFile, sourceLine);456 } else {457 return &unit->BeginIoStatement<InquireUnitState>(458 terminator, *unit, sourceFile, sourceLine);459 }460 } else {461 return &New<InquireUnconnectedFileState>{terminator}(462 std::move(trimmed), sourceFile, sourceLine)463 .release()464 ->ioStatementState();465 }466}467 468Cookie IODEF(BeginInquireIoLength)(const char *sourceFile, int sourceLine) {469 Terminator oom{sourceFile, sourceLine};470 return &New<InquireIOLengthState>{oom}(sourceFile, sourceLine)471 .release()472 ->ioStatementState();473}474 475// Control list items476 477void IODEF(EnableHandlers)(Cookie cookie, bool hasIoStat, bool hasErr,478 bool hasEnd, bool hasEor, bool hasIoMsg) {479 IoErrorHandler &handler{cookie->GetIoErrorHandler()};480 if (hasIoStat) {481 handler.HasIoStat();482 }483 if (hasErr) {484 handler.HasErrLabel();485 }486 if (hasEnd) {487 handler.HasEndLabel();488 }489 if (hasEor) {490 handler.HasEorLabel();491 }492 if (hasIoMsg) {493 handler.HasIoMsg();494 }495}496 497static RT_API_ATTRS bool YesOrNo(const char *keyword, std::size_t length,498 const char *what, IoErrorHandler &handler) {499 static const char *keywords[]{"YES", "NO", nullptr};500 switch (IdentifyValue(keyword, length, keywords)) {501 case 0:502 return true;503 case 1:504 return false;505 default:506 handler.SignalError(IostatErrorInKeyword, "Invalid %s='%.*s'", what,507 static_cast<int>(length), keyword);508 return false;509 }510}511 512bool IODEF(SetAdvance)(Cookie cookie, const char *keyword, std::size_t length) {513 IoStatementState &io{*cookie};514 IoErrorHandler &handler{io.GetIoErrorHandler()};515 bool nonAdvancing{!YesOrNo(keyword, length, "ADVANCE", handler)};516 if (nonAdvancing && io.GetConnectionState().access == Access::Direct) {517 handler.SignalError("Non-advancing I/O attempted on direct access file");518 } else {519 auto *unit{io.GetExternalFileUnit()};520 if (unit && unit->GetChildIo()) {521 // ADVANCE= is ignored for child I/O (12.6.4.8.3 p3)522 } else {523 io.mutableModes().nonAdvancing = nonAdvancing;524 }525 }526 return !handler.InError();527}528 529bool IODEF(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) {530 IoStatementState &io{*cookie};531 if (auto *open{io.get_if<OpenStatementState>()}) {532 open->set_mustBeFormatted();533 }534 static const char *keywords[]{"NULL", "ZERO", nullptr};535 switch (IdentifyValue(keyword, length, keywords)) {536 case 0:537 io.mutableModes().editingFlags &= ~blankZero;538 return true;539 case 1:540 io.mutableModes().editingFlags |= blankZero;541 return true;542 default:543 io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,544 "Invalid BLANK='%.*s'", static_cast<int>(length), keyword);545 return false;546 }547}548 549bool IODEF(SetDecimal)(Cookie cookie, const char *keyword, std::size_t length) {550 IoStatementState &io{*cookie};551 if (auto *open{io.get_if<OpenStatementState>()}) {552 open->set_mustBeFormatted();553 }554 static const char *keywords[]{"COMMA", "POINT", nullptr};555 switch (IdentifyValue(keyword, length, keywords)) {556 case 0:557 io.mutableModes().editingFlags |= decimalComma;558 return true;559 case 1:560 io.mutableModes().editingFlags &= ~decimalComma;561 return true;562 default:563 io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,564 "Invalid DECIMAL='%.*s'", static_cast<int>(length), keyword);565 return false;566 }567}568 569bool IODEF(SetDelim)(Cookie cookie, const char *keyword, std::size_t length) {570 IoStatementState &io{*cookie};571 if (auto *open{io.get_if<OpenStatementState>()}) {572 open->set_mustBeFormatted();573 }574 static const char *keywords[]{"APOSTROPHE", "QUOTE", "NONE", nullptr};575 switch (IdentifyValue(keyword, length, keywords)) {576 case 0:577 io.mutableModes().delim = '\'';578 return true;579 case 1:580 io.mutableModes().delim = '"';581 return true;582 case 2:583 io.mutableModes().delim = '\0';584 return true;585 default:586 io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,587 "Invalid DELIM='%.*s'", static_cast<int>(length), keyword);588 return false;589 }590}591 592bool IODEF(SetPad)(Cookie cookie, const char *keyword, std::size_t length) {593 IoStatementState &io{*cookie};594 IoErrorHandler &handler{io.GetIoErrorHandler()};595 if (auto *open{io.get_if<OpenStatementState>()}) {596 open->set_mustBeFormatted();597 }598 io.mutableModes().pad = YesOrNo(keyword, length, "PAD", handler);599 return !handler.InError();600}601 602bool IODEF(SetPos)(Cookie cookie, std::int64_t pos) {603 IoStatementState &io{*cookie};604 IoErrorHandler &handler{io.GetIoErrorHandler()};605 if (auto *unit{io.GetExternalFileUnit()}) {606 return unit->SetStreamPos(pos, handler);607 } else if (!io.get_if<ErroneousIoStatementState>()) {608 handler.Crash("SetPos() called on internal unit");609 }610 return false;611}612 613bool IODEF(SetRec)(Cookie cookie, std::int64_t rec) {614 IoStatementState &io{*cookie};615 IoErrorHandler &handler{io.GetIoErrorHandler()};616 if (auto *unit{io.GetExternalFileUnit()}) {617 if (unit->GetChildIo()) {618 handler.SignalError(619 IostatBadOpOnChildUnit, "REC= specifier on child I/O");620 } else {621 handler.HasRec();622 unit->SetDirectRec(rec, handler);623 }624 } else if (!io.get_if<ErroneousIoStatementState>()) {625 handler.Crash("SetRec() called on internal unit");626 }627 return true;628}629 630bool IODEF(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {631 IoStatementState &io{*cookie};632 if (auto *open{io.get_if<OpenStatementState>()}) {633 open->set_mustBeFormatted();634 }635 static const char *keywords[]{"UP", "DOWN", "ZERO", "NEAREST", "COMPATIBLE",636 "PROCESSOR_DEFINED", nullptr};637 switch (IdentifyValue(keyword, length, keywords)) {638 case 0:639 io.mutableModes().round = decimal::RoundUp;640 return true;641 case 1:642 io.mutableModes().round = decimal::RoundDown;643 return true;644 case 2:645 io.mutableModes().round = decimal::RoundToZero;646 return true;647 case 3:648 io.mutableModes().round = decimal::RoundNearest;649 return true;650 case 4:651 io.mutableModes().round = decimal::RoundCompatible;652 return true;653 case 5:654 io.mutableModes().round = executionEnvironment.defaultOutputRoundingMode;655 return true;656 default:657 io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,658 "Invalid ROUND='%.*s'", static_cast<int>(length), keyword);659 return false;660 }661}662 663bool IODEF(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {664 IoStatementState &io{*cookie};665 if (auto *open{io.get_if<OpenStatementState>()}) {666 open->set_mustBeFormatted();667 }668 static const char *keywords[]{669 "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", nullptr};670 switch (IdentifyValue(keyword, length, keywords)) {671 case 0:672 io.mutableModes().editingFlags |= signPlus;673 return true;674 case 1:675 case 2: // processor default is SS676 io.mutableModes().editingFlags &= ~signPlus;677 return true;678 default:679 io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,680 "Invalid SIGN='%.*s'", static_cast<int>(length), keyword);681 return false;682 }683}684 685bool IODEF(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {686 IoStatementState &io{*cookie};687 auto *open{io.get_if<OpenStatementState>()};688 if (!open) {689 if (!io.get_if<NoopStatementState>() &&690 !io.get_if<ErroneousIoStatementState>()) {691 io.GetIoErrorHandler().Crash(692 "SetAccess() called when not in an OPEN statement");693 }694 return false;695 } else if (open->completedOperation()) {696 io.GetIoErrorHandler().Crash(697 "SetAccess() called after GetNewUnit() for an OPEN statement");698 }699 static const char *keywords[]{700 "SEQUENTIAL", "DIRECT", "STREAM", "APPEND", nullptr};701 switch (IdentifyValue(keyword, length, keywords)) {702 case 0:703 open->set_access(Access::Sequential);704 break;705 case 1:706 open->set_access(Access::Direct);707 break;708 case 2:709 open->set_access(Access::Stream);710 break;711 case 3: // Sun Fortran extension ACCESS=APPEND: treat as if POSITION=APPEND712 open->set_position(Position::Append);713 break;714 default:715 open->SignalError(IostatErrorInKeyword, "Invalid ACCESS='%.*s'",716 static_cast<int>(length), keyword);717 }718 return true;719}720 721bool IODEF(SetAction)(Cookie cookie, const char *keyword, std::size_t length) {722 IoStatementState &io{*cookie};723 auto *open{io.get_if<OpenStatementState>()};724 if (!open) {725 if (!io.get_if<NoopStatementState>() &&726 !io.get_if<ErroneousIoStatementState>()) {727 io.GetIoErrorHandler().Crash(728 "SetAction() called when not in an OPEN statement");729 }730 return false;731 } else if (open->completedOperation()) {732 io.GetIoErrorHandler().Crash(733 "SetAction() called after GetNewUnit() for an OPEN statement");734 }735 common::optional<Action> action;736 static const char *keywords[]{"READ", "WRITE", "READWRITE", nullptr};737 switch (IdentifyValue(keyword, length, keywords)) {738 case 0:739 action = Action::Read;740 break;741 case 1:742 action = Action::Write;743 break;744 case 2:745 action = Action::ReadWrite;746 break;747 default:748 open->SignalError(IostatErrorInKeyword, "Invalid ACTION='%.*s'",749 static_cast<int>(length), keyword);750 return false;751 }752 RUNTIME_CHECK(io.GetIoErrorHandler(), action.has_value());753 if (open->wasExtant()) {754 if ((*action != Action::Write) != open->unit().mayRead() ||755 (*action != Action::Read) != open->unit().mayWrite()) {756 open->SignalError("ACTION= may not be changed on an open unit");757 }758 }759 open->set_action(*action);760 return true;761}762 763bool IODEF(SetAsynchronous)(764 Cookie cookie, const char *keyword, std::size_t length) {765 IoStatementState &io{*cookie};766 IoErrorHandler &handler{io.GetIoErrorHandler()};767 bool isYes{YesOrNo(keyword, length, "ASYNCHRONOUS", handler)};768 if (auto *open{io.get_if<OpenStatementState>()}) {769 if (open->completedOperation()) {770 handler.Crash(771 "SetAsynchronous() called after GetNewUnit() for an OPEN statement");772 }773 open->unit().set_mayAsynchronous(isYes);774 } else if (!isYes) {775 // ASYNCHRONOUS='NO' is the default, so this is a no-op776 } else if (auto *ext{io.get_if<ExternalIoStatementBase>()}) {777 if (ext->unit().mayAsynchronous()) {778 ext->SetAsynchronous();779 } else {780 handler.SignalError(IostatBadAsynchronous);781 }782 } else if (!io.get_if<NoopStatementState>() &&783 !io.get_if<ErroneousIoStatementState>()) {784 handler.Crash("SetAsynchronous('YES') called when not in an OPEN or "785 "external I/O statement");786 }787 return !handler.InError();788}789 790bool IODEF(SetCarriagecontrol)(791 Cookie cookie, const char *keyword, std::size_t length) {792 IoStatementState &io{*cookie};793 auto *open{io.get_if<OpenStatementState>()};794 if (!open) {795 if (!io.get_if<NoopStatementState>() &&796 !io.get_if<ErroneousIoStatementState>()) {797 io.GetIoErrorHandler().Crash(798 "SetCarriageControl() called when not in an OPEN statement");799 }800 return false;801 } else if (open->completedOperation()) {802 io.GetIoErrorHandler().Crash(803 "SetCarriageControl() called after GetNewUnit() for an OPEN statement");804 }805 open->set_mustBeFormatted();806 static const char *keywords[]{"LIST", "FORTRAN", "NONE", nullptr};807 switch (IdentifyValue(keyword, length, keywords)) {808 case 0:809 return true;810 case 1:811 case 2:812 open->SignalError(IostatErrorInKeyword,813 "Unimplemented CARRIAGECONTROL='%.*s'", static_cast<int>(length),814 keyword);815 return false;816 default:817 open->SignalError(IostatErrorInKeyword, "Invalid CARRIAGECONTROL='%.*s'",818 static_cast<int>(length), keyword);819 return false;820 }821}822 823bool IODEF(SetConvert)(Cookie cookie, const char *keyword, std::size_t length) {824 IoStatementState &io{*cookie};825 auto *open{io.get_if<OpenStatementState>()};826 if (!open) {827 if (!io.get_if<NoopStatementState>() &&828 !io.get_if<ErroneousIoStatementState>()) {829 io.GetIoErrorHandler().Crash(830 "SetConvert() called when not in an OPEN statement");831 }832 return false;833 } else if (open->completedOperation()) {834 io.GetIoErrorHandler().Crash(835 "SetConvert() called after GetNewUnit() for an OPEN statement");836 }837 if (auto convert{GetConvertFromString(keyword, length)}) {838 open->set_convert(*convert);839 return true;840 } else {841 open->SignalError(IostatErrorInKeyword, "Invalid CONVERT='%.*s'",842 static_cast<int>(length), keyword);843 return false;844 }845}846 847bool IODEF(SetEncoding)(848 Cookie cookie, const char *keyword, std::size_t length) {849 IoStatementState &io{*cookie};850 auto *open{io.get_if<OpenStatementState>()};851 if (!open) {852 if (!io.get_if<NoopStatementState>() &&853 !io.get_if<ErroneousIoStatementState>()) {854 io.GetIoErrorHandler().Crash(855 "SetEncoding() called when not in an OPEN statement");856 }857 return false;858 } else if (open->completedOperation()) {859 io.GetIoErrorHandler().Crash(860 "SetEncoding() called after GetNewUnit() for an OPEN statement");861 }862 open->set_mustBeFormatted();863 // Allow the encoding to be changed on an open unit -- it's864 // useful and safe.865 static const char *keywords[]{"UTF-8", "DEFAULT", nullptr};866 switch (IdentifyValue(keyword, length, keywords)) {867 case 0:868 open->unit().isUTF8 = true;869 break;870 case 1:871 open->unit().isUTF8 = false;872 break;873 default:874 open->SignalError(IostatErrorInKeyword, "Invalid ENCODING='%.*s'",875 static_cast<int>(length), keyword);876 }877 return true;878}879 880bool IODEF(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {881 IoStatementState &io{*cookie};882 auto *open{io.get_if<OpenStatementState>()};883 if (!open) {884 if (!io.get_if<NoopStatementState>() &&885 !io.get_if<ErroneousIoStatementState>()) {886 io.GetIoErrorHandler().Crash(887 "SetForm() called when not in an OPEN statement");888 }889 } else if (open->completedOperation()) {890 io.GetIoErrorHandler().Crash(891 "SetForm() called after GetNewUnit() for an OPEN statement");892 }893 static const char *keywords[]{"FORMATTED", "UNFORMATTED", "BINARY", nullptr};894 switch (IdentifyValue(keyword, length, keywords)) {895 case 0: // FORM='FORMATTED'896 open->set_isUnformatted(false);897 break;898 case 1: // FORM='UNFORMATTED'899 open->set_isUnformatted(true);900 break;901 case 2: // legacy FORM='BINARY' means an unformatted stream902 open->set_isUnformatted(true);903 open->set_access(Access::Stream);904 break;905 default:906 open->SignalError(IostatErrorInKeyword, "Invalid FORM='%.*s'",907 static_cast<int>(length), keyword);908 }909 return true;910}911 912bool IODEF(SetPosition)(913 Cookie cookie, const char *keyword, std::size_t length) {914 IoStatementState &io{*cookie};915 auto *open{io.get_if<OpenStatementState>()};916 if (!open) {917 if (!io.get_if<NoopStatementState>() &&918 !io.get_if<ErroneousIoStatementState>()) {919 io.GetIoErrorHandler().Crash(920 "SetPosition() called when not in an OPEN statement");921 }922 return false;923 } else if (open->completedOperation()) {924 io.GetIoErrorHandler().Crash(925 "SetPosition() called after GetNewUnit() for an OPEN statement");926 }927 static const char *positions[]{"ASIS", "REWIND", "APPEND", nullptr};928 switch (IdentifyValue(keyword, length, positions)) {929 case 0:930 open->set_position(Position::AsIs);931 return true;932 case 1:933 open->set_position(Position::Rewind);934 return true;935 case 2:936 open->set_position(Position::Append);937 return true;938 default:939 io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,940 "Invalid POSITION='%.*s'", static_cast<int>(length), keyword);941 }942 return true;943}944 945bool IODEF(SetRecl)(Cookie cookie, std::size_t n) {946 IoStatementState &io{*cookie};947 auto *open{io.get_if<OpenStatementState>()};948 if (!open) {949 if (!io.get_if<NoopStatementState>() &&950 !io.get_if<ErroneousIoStatementState>()) {951 io.GetIoErrorHandler().Crash(952 "SetRecl() called when not in an OPEN statement");953 }954 return false;955 } else if (open->completedOperation()) {956 io.GetIoErrorHandler().Crash(957 "SetRecl() called after GetNewUnit() for an OPEN statement");958 }959 if (static_cast<std::int64_t>(n) <= 0) {960 io.GetIoErrorHandler().SignalError("RECL= must be greater than zero");961 return false;962 } else if (open->wasExtant() &&963 open->unit().openRecl.value_or(0) != static_cast<std::int64_t>(n)) {964 open->SignalError("RECL= may not be changed for an open unit");965 return false;966 } else {967 open->unit().openRecl = n;968 return true;969 }970}971 972bool IODEF(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {973 IoStatementState &io{*cookie};974 if (auto *open{io.get_if<OpenStatementState>()}) {975 if (open->completedOperation()) {976 io.GetIoErrorHandler().Crash(977 "SetStatus() called after GetNewUnit() for an OPEN statement");978 }979 static const char *statuses[]{980 "OLD", "NEW", "SCRATCH", "REPLACE", "UNKNOWN", nullptr};981 switch (IdentifyValue(keyword, length, statuses)) {982 case 0:983 open->set_status(OpenStatus::Old);984 return true;985 case 1:986 open->set_status(OpenStatus::New);987 return true;988 case 2:989 open->set_status(OpenStatus::Scratch);990 return true;991 case 3:992 open->set_status(OpenStatus::Replace);993 return true;994 case 4:995 open->set_status(OpenStatus::Unknown);996 return true;997 default:998 io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,999 "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);1000 }1001 return false;1002 }1003 if (auto *close{io.get_if<CloseStatementState>()}) {1004 static const char *statuses[]{"KEEP", "DELETE", nullptr};1005 switch (IdentifyValue(keyword, length, statuses)) {1006 case 0:1007 close->set_status(CloseStatus::Keep);1008 return true;1009 case 1:1010 close->set_status(CloseStatus::Delete);1011 return true;1012 default:1013 io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,1014 "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);1015 }1016 return false;1017 }1018 if (io.get_if<NoopStatementState>() ||1019 io.get_if<ErroneousIoStatementState>()) {1020 return true; // don't bother validating STATUS= in a no-op CLOSE1021 }1022 io.GetIoErrorHandler().Crash(1023 "SetStatus() called when not in an OPEN or CLOSE statement");1024}1025 1026bool IODEF(SetFile)(Cookie cookie, const char *path, std::size_t chars) {1027 IoStatementState &io{*cookie};1028 if (auto *open{io.get_if<OpenStatementState>()}) {1029 if (open->completedOperation()) {1030 io.GetIoErrorHandler().Crash(1031 "SetFile() called after GetNewUnit() for an OPEN statement");1032 }1033 open->set_path(path, chars);1034 return true;1035 } else if (!io.get_if<NoopStatementState>() &&1036 !io.get_if<ErroneousIoStatementState>()) {1037 io.GetIoErrorHandler().Crash(1038 "SetFile() called when not in an OPEN statement");1039 }1040 return false;1041}1042 1043bool IODEF(GetNewUnit)(Cookie cookie, int &unit, int kind) {1044 IoStatementState &io{*cookie};1045 auto *open{io.get_if<OpenStatementState>()};1046 if (!open) {1047 if (!io.get_if<NoopStatementState>() &&1048 !io.get_if<ErroneousIoStatementState>()) {1049 io.GetIoErrorHandler().Crash(1050 "GetNewUnit() called when not in an OPEN statement");1051 }1052 return false;1053 } else if (!open->InError()) {1054 open->CompleteOperation();1055 }1056 if (open->InError()) {1057 // A failed OPEN(NEWUNIT=n) does not modify 'n'1058 return false;1059 }1060 std::int64_t result{open->unit().unitNumber()};1061 if (!SetInteger(unit, kind, result)) {1062 open->SignalError("GetNewUnit(): bad INTEGER kind(%d) or out-of-range "1063 "value(%jd) for result",1064 kind, static_cast<std::intmax_t>(result));1065 }1066 return true;1067}1068 1069// Data transfers1070 1071bool IODEF(OutputDescriptor)(Cookie cookie, const Descriptor &descriptor) {1072 return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);1073}1074 1075bool IODEF(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {1076 return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);1077}1078 1079bool IODEF(InputInteger)(Cookie cookie, std::int64_t &n, int kind) {1080 IoStatementState &io{*cookie};1081 if (io.BeginReadingRecord()) {1082 if (auto edit{io.GetNextDataEdit()}) {1083 return edit->descriptor == DataEdit::ListDirectedNullValue ||1084 EditIntegerInput(io, *edit, reinterpret_cast<void *>(&n), kind,1085 /*isSigned=*/true);1086 }1087 }1088 return false;1089}1090 1091bool IODEF(InputReal32)(Cookie cookie, float &x) {1092 if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal32")) {1093 return false;1094 }1095 StaticDescriptor<0> staticDescriptor;1096 Descriptor &descriptor{staticDescriptor.descriptor()};1097 descriptor.Establish(TypeCategory::Real, 4, reinterpret_cast<void *>(&x), 0);1098 return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);1099}1100 1101bool IODEF(InputReal64)(Cookie cookie, double &x) {1102 if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal64")) {1103 return false;1104 }1105 StaticDescriptor<0> staticDescriptor;1106 Descriptor &descriptor{staticDescriptor.descriptor()};1107 descriptor.Establish(TypeCategory::Real, 8, reinterpret_cast<void *>(&x), 0);1108 return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);1109}1110 1111bool IODEF(InputComplex32)(Cookie cookie, float z[2]) {1112 if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex32")) {1113 return false;1114 }1115 StaticDescriptor<0> staticDescriptor;1116 Descriptor &descriptor{staticDescriptor.descriptor()};1117 descriptor.Establish(1118 TypeCategory::Complex, 4, reinterpret_cast<void *>(z), 0);1119 return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);1120}1121 1122bool IODEF(InputComplex64)(Cookie cookie, double z[2]) {1123 if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex64")) {1124 return false;1125 }1126 StaticDescriptor<0> staticDescriptor;1127 Descriptor &descriptor{staticDescriptor.descriptor()};1128 descriptor.Establish(1129 TypeCategory::Complex, 8, reinterpret_cast<void *>(z), 0);1130 return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);1131}1132 1133bool IODEF(OutputCharacter)(1134 Cookie cookie, const char *x, std::size_t length, int kind) {1135 if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputCharacter")) {1136 return false;1137 }1138 StaticDescriptor<0> staticDescriptor;1139 Descriptor &descriptor{staticDescriptor.descriptor()};1140 descriptor.Establish(1141 kind, length, reinterpret_cast<void *>(const_cast<char *>(x)), 0);1142 return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);1143}1144 1145bool IODEF(InputCharacter)(1146 Cookie cookie, char *x, std::size_t length, int kind) {1147 if (!cookie->CheckFormattedStmtType<Direction::Input>("InputCharacter")) {1148 return false;1149 }1150 StaticDescriptor<0> staticDescriptor;1151 Descriptor &descriptor{staticDescriptor.descriptor()};1152 descriptor.Establish(kind, length, reinterpret_cast<void *>(x), 0);1153 return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);1154}1155 1156bool IODEF(InputAscii)(Cookie cookie, char *x, std::size_t length) {1157 return IONAME(InputCharacter)(cookie, x, length, 1);1158}1159 1160bool IODEF(InputLogical)(Cookie cookie, bool &truth) {1161 if (!cookie->CheckFormattedStmtType<Direction::Input>("InputLogical")) {1162 return false;1163 }1164 StaticDescriptor<0> staticDescriptor;1165 Descriptor &descriptor{staticDescriptor.descriptor()};1166 descriptor.Establish(1167 TypeCategory::Logical, sizeof truth, reinterpret_cast<void *>(&truth), 0);1168 return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);1169}1170 1171bool IODEF(OutputDerivedType)(Cookie cookie, const Descriptor &descriptor,1172 const NonTbpDefinedIoTable *table) {1173 return descr::DescriptorIO<Direction::Output>(*cookie, descriptor, table);1174}1175 1176bool IODEF(InputDerivedType)(Cookie cookie, const Descriptor &descriptor,1177 const NonTbpDefinedIoTable *table) {1178 return descr::DescriptorIO<Direction::Input>(*cookie, descriptor, table);1179}1180 1181std::size_t IODEF(GetSize)(Cookie cookie) {1182 IoStatementState &io{*cookie};1183 IoErrorHandler &handler{io.GetIoErrorHandler()};1184 if (!handler.InError()) {1185 io.CompleteOperation();1186 }1187 if (const auto *formatted{1188 io.get_if<FormattedIoStatementState<Direction::Input>>()}) {1189 return formatted->GetEditDescriptorChars();1190 } else if (!io.get_if<NoopStatementState>() &&1191 !io.get_if<ErroneousIoStatementState>()) {1192 handler.Crash("GetIoSize() called for an I/O statement that is not a "1193 "formatted READ()");1194 }1195 return 0;1196}1197 1198std::size_t IODEF(GetIoLength)(Cookie cookie) {1199 IoStatementState &io{*cookie};1200 IoErrorHandler &handler{io.GetIoErrorHandler()};1201 if (!handler.InError()) {1202 io.CompleteOperation();1203 }1204 if (const auto *inq{io.get_if<InquireIOLengthState>()}) {1205 return inq->bytes();1206 } else if (!io.get_if<NoopStatementState>() &&1207 !io.get_if<ErroneousIoStatementState>()) {1208 handler.Crash("GetIoLength() called for an I/O statement that is not "1209 "INQUIRE(IOLENGTH=)");1210 }1211 return 0;1212}1213 1214void IODEF(GetIoMsg)(Cookie cookie, char *msg, std::size_t length) {1215 IoStatementState &io{*cookie};1216 IoErrorHandler &handler{io.GetIoErrorHandler()};1217 if (!handler.InError()) {1218 io.CompleteOperation();1219 }1220 if (handler.InError()) { // leave "msg" alone when no error1221 handler.GetIoMsg(msg, length);1222 }1223}1224 1225AsynchronousId IODEF(GetAsynchronousId)(Cookie cookie) {1226 IoStatementState &io{*cookie};1227 IoErrorHandler &handler{io.GetIoErrorHandler()};1228 if (auto *ext{io.get_if<ExternalIoStatementBase>()}) {1229 return ext->asynchronousID();1230 } else if (!io.get_if<NoopStatementState>() &&1231 !io.get_if<ErroneousIoStatementState>()) {1232 handler.Crash(1233 "GetAsynchronousId() called when not in an external I/O statement");1234 }1235 return 0;1236}1237 1238bool IODEF(InquireCharacter)(Cookie cookie, InquiryKeywordHash inquiry,1239 char *result, std::size_t length) {1240 IoStatementState &io{*cookie};1241 return io.Inquire(inquiry, result, length);1242}1243 1244bool IODEF(InquireLogical)(1245 Cookie cookie, InquiryKeywordHash inquiry, bool &result) {1246 IoStatementState &io{*cookie};1247 return io.Inquire(inquiry, result);1248}1249 1250bool IODEF(InquirePendingId)(Cookie cookie, AsynchronousId id, bool &result) {1251 IoStatementState &io{*cookie};1252 return io.Inquire(HashInquiryKeyword("PENDING"), id, result);1253}1254 1255bool IODEF(InquireInteger64)(1256 Cookie cookie, InquiryKeywordHash inquiry, std::int64_t &result, int kind) {1257 IoStatementState &io{*cookie};1258 std::int64_t n{0}; // safe "undefined" value1259 if (io.Inquire(inquiry, n)) {1260 if (SetInteger(result, kind, n)) {1261 return true;1262 }1263 io.GetIoErrorHandler().SignalError(1264 "InquireInteger64(): bad INTEGER kind(%d) or out-of-range "1265 "value(%jd) for result",1266 kind, static_cast<std::intmax_t>(n));1267 }1268 return false;1269}1270 1271template <typename INT>1272static RT_API_ATTRS enum Iostat CheckUnitNumberInRangeImpl(INT unit,1273 bool handleError, char *ioMsg, std::size_t ioMsgLength,1274 const char *sourceFile, int sourceLine) {1275 static_assert(sizeof(INT) >= sizeof(ExternalUnit),1276 "only intended to be used when the INT to ExternalUnit conversion is "1277 "narrowing");1278 if (unit != static_cast<ExternalUnit>(unit)) {1279 Terminator oom{sourceFile, sourceLine};1280 IoErrorHandler errorHandler{oom};1281 if (handleError) {1282 errorHandler.HasIoStat();1283 if (ioMsg) {1284 errorHandler.HasIoMsg();1285 }1286 }1287 // Only provide the bad unit number in the message if SignalError can print1288 // it accurately. Otherwise, the generic IostatUnitOverflow message will be1289 // used.1290 if constexpr (sizeof(INT) > sizeof(std::intmax_t)) {1291 errorHandler.SignalError(IostatUnitOverflow);1292 } else if (static_cast<std::intmax_t>(unit) == unit) {1293 errorHandler.SignalError(IostatUnitOverflow,1294 "UNIT number %jd is out of range", static_cast<std::intmax_t>(unit));1295 } else {1296 errorHandler.SignalError(IostatUnitOverflow);1297 }1298 if (ioMsg) {1299 errorHandler.GetIoMsg(ioMsg, ioMsgLength);1300 }1301 return static_cast<enum Iostat>(errorHandler.GetIoStat());1302 }1303 return IostatOk;1304}1305 1306enum Iostat IODEF(CheckUnitNumberInRange64)(std::int64_t unit, bool handleError,1307 char *ioMsg, std::size_t ioMsgLength, const char *sourceFile,1308 int sourceLine) {1309 return CheckUnitNumberInRangeImpl(1310 unit, handleError, ioMsg, ioMsgLength, sourceFile, sourceLine);1311}1312 1313#ifdef __SIZEOF_INT128__1314enum Iostat IODEF(CheckUnitNumberInRange128)(common::int128_t unit,1315 bool handleError, char *ioMsg, std::size_t ioMsgLength,1316 const char *sourceFile, int sourceLine) {1317 return CheckUnitNumberInRangeImpl(1318 unit, handleError, ioMsg, ioMsgLength, sourceFile, sourceLine);1319}1320#endif1321 1322RT_EXT_API_GROUP_END1323} // namespace Fortran::runtime::io1324