flang/runtime/io-api.cpp

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