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       handler.HasRec();
 627       unit->SetDirectRec(rec, handler);
 628     }
 629   } else if (!io.get_if<ErroneousIoStatementState>()) {
 630     handler.Crash("SetRec() called on internal unit");
 631   }
 632   return true;
 633 }
 634
 635 bool IODEF(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
 636   IoStatementState &io{*cookie};
 637   static const char *keywords[]{"UP", "DOWN", "ZERO", "NEAREST", "COMPATIBLE",
 638       "PROCESSOR_DEFINED", nullptr};
 639   switch (IdentifyValue(keyword, length, keywords)) {
 640   case 0:
 641     io.mutableModes().round = decimal::RoundUp;
 642     return true;
 643   case 1:
 644     io.mutableModes().round = decimal::RoundDown;
 645     return true;
 646   case 2:
 647     io.mutableModes().round = decimal::RoundToZero;
 648     return true;
 649   case 3:
 650     io.mutableModes().round = decimal::RoundNearest;
 651     return true;
 652   case 4:
 653     io.mutableModes().round = decimal::RoundCompatible;
 654     return true;
 655   case 5:
 656     io.mutableModes().round = executionEnvironment.defaultOutputRoundingMode;
 657     return true;
 658   default:
 659     io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
 660         "Invalid ROUND='%.*s'", static_cast<int>(length), keyword);
 661     return false;
 662   }
 663 }
 664
 665 bool IODEF(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {
 666   IoStatementState &io{*cookie};
 667   static const char *keywords[]{
 668       "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", nullptr};
 669   switch (IdentifyValue(keyword, length, keywords)) {
 670   case 0:
 671     io.mutableModes().editingFlags |= signPlus;
 672     return true;
 673   case 1:
 674   case 2: // processor default is SS
 675     io.mutableModes().editingFlags &= ~signPlus;
 676     return true;
 677   default:
 678     io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
 679         "Invalid SIGN='%.*s'", static_cast<int>(length), keyword);
 680     return false;
 681   }
 682 }
 683
 684 bool IODEF(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {
 685   IoStatementState &io{*cookie};
 686   auto *open{io.get_if<OpenStatementState>()};
 687   if (!open) {
 688     if (!io.get_if<NoopStatementState>() &&
 689         !io.get_if<ErroneousIoStatementState>()) {
 690       io.GetIoErrorHandler().Crash(
 691           "SetAccess() called when not in an OPEN statement");
 692     }
 693     return false;
 694   } else if (open->completedOperation()) {
 695     io.GetIoErrorHandler().Crash(
 696         "SetAccess() called after GetNewUnit() for an OPEN statement");
 697   }
 698   static const char *keywords[]{
 699       "SEQUENTIAL", "DIRECT", "STREAM", "APPEND", nullptr};
 700   switch (IdentifyValue(keyword, length, keywords)) {
 701   case 0:
 702     open->set_access(Access::Sequential);
 703     break;
 704   case 1:
 705     open->set_access(Access::Direct);
 706     break;
 707   case 2:
 708     open->set_access(Access::Stream);
 709     break;
 710   case 3: // Sun Fortran extension ACCESS=APPEND: treat as if POSITION=APPEND
 711     open->set_position(Position::Append);
 712     break;
 713   default:
 714     open->SignalError(IostatErrorInKeyword, "Invalid ACCESS='%.*s'",
 715         static_cast<int>(length), keyword);
 716   }
 717   return true;
 718 }
 719
 720 bool IODEF(SetAction)(Cookie cookie, const char *keyword, std::size_t length) {
 721   IoStatementState &io{*cookie};
 722   auto *open{io.get_if<OpenStatementState>()};
 723   if (!open) {
 724     if (!io.get_if<NoopStatementState>() &&
 725         !io.get_if<ErroneousIoStatementState>()) {
 726       io.GetIoErrorHandler().Crash(
 727           "SetAction() called when not in an OPEN statement");
 728     }
 729     return false;
 730   } else if (open->completedOperation()) {
 731     io.GetIoErrorHandler().Crash(
 732         "SetAction() called after GetNewUnit() for an OPEN statement");
 733   }
 734   Fortran::common::optional<Action> action;
 735   static const char *keywords[]{"READ", "WRITE", "READWRITE", nullptr};
 736   switch (IdentifyValue(keyword, length, keywords)) {
 737   case 0:
 738     action = Action::Read;
 739     break;
 740   case 1:
 741     action = Action::Write;
 742     break;
 743   case 2:
 744     action = Action::ReadWrite;
 745     break;
 746   default:
 747     open->SignalError(IostatErrorInKeyword, "Invalid ACTION='%.*s'",
 748         static_cast<int>(length), keyword);
 749     return false;
 750   }
 751   RUNTIME_CHECK(io.GetIoErrorHandler(), action.has_value());
 752   if (open->wasExtant()) {
 753     if ((*action != Action::Write) != open->unit().mayRead() ||
 754         (*action != Action::Read) != open->unit().mayWrite()) {
 755       open->SignalError("ACTION= may not be changed on an open unit");
 756     }
 757   }
 758   open->set_action(*action);
 759   return true;
 760 }
 761
 762 bool IODEF(SetAsynchronous)(
 763     Cookie cookie, const char *keyword, std::size_t length) {
 764   IoStatementState &io{*cookie};
 765   IoErrorHandler &handler{io.GetIoErrorHandler()};
 766   bool isYes{YesOrNo(keyword, length, "ASYNCHRONOUS", handler)};
 767   if (auto *open{io.get_if<OpenStatementState>()}) {
 768     if (open->completedOperation()) {
 769       handler.Crash(
 770           "SetAsynchronous() called after GetNewUnit() for an OPEN statement");
 771     }
 772     open->unit().set_mayAsynchronous(isYes);
 773   } else if (!isYes) {
 774     // ASYNCHRONOUS='NO' is the default, so this is a no-op
 775   } else if (auto *ext{io.get_if<ExternalIoStatementBase>()}) {
 776     if (ext->unit().mayAsynchronous()) {
 777       ext->SetAsynchronous();
 778     } else {
 779       handler.SignalError(IostatBadAsynchronous);
 780     }
 781   } else if (!io.get_if<NoopStatementState>() &&
 782       !io.get_if<ErroneousIoStatementState>()) {
 783     handler.Crash("SetAsynchronous('YES') called when not in an OPEN or "
 784                   "external I/O statement");
 785   }
 786   return !handler.InError();
 787 }
 788
 789 bool IODEF(SetCarriagecontrol)(
 790     Cookie cookie, const char *keyword, std::size_t length) {
 791   IoStatementState &io{*cookie};
 792   auto *open{io.get_if<OpenStatementState>()};
 793   if (!open) {
 794     if (!io.get_if<NoopStatementState>() &&
 795         !io.get_if<ErroneousIoStatementState>()) {
 796       io.GetIoErrorHandler().Crash(
 797           "SetCarriageControl() called when not in an OPEN statement");
 798     }
 799     return false;
 800   } else if (open->completedOperation()) {
 801     io.GetIoErrorHandler().Crash(
 802         "SetCarriageControl() called after GetNewUnit() for an OPEN statement");
 803   }
 804   static const char *keywords[]{"LIST", "FORTRAN", "NONE", nullptr};
 805   switch (IdentifyValue(keyword, length, keywords)) {
 806   case 0:
 807     return true;
 808   case 1:
 809   case 2:
 810     open->SignalError(IostatErrorInKeyword,
 811         "Unimplemented CARRIAGECONTROL='%.*s'", static_cast<int>(length),
 812         keyword);
 813     return false;
 814   default:
 815     open->SignalError(IostatErrorInKeyword, "Invalid CARRIAGECONTROL='%.*s'",
 816         static_cast<int>(length), keyword);
 817     return false;
 818   }
 819 }
 820
 821 bool IODEF(SetConvert)(Cookie cookie, const char *keyword, std::size_t length) {
 822   IoStatementState &io{*cookie};
 823   auto *open{io.get_if<OpenStatementState>()};
 824   if (!open) {
 825     if (!io.get_if<NoopStatementState>() &&
 826         !io.get_if<ErroneousIoStatementState>()) {
 827       io.GetIoErrorHandler().Crash(
 828           "SetConvert() called when not in an OPEN statement");
 829     }
 830     return false;
 831   } else if (open->completedOperation()) {
 832     io.GetIoErrorHandler().Crash(
 833         "SetConvert() called after GetNewUnit() for an OPEN statement");
 834   }
 835   if (auto convert{GetConvertFromString(keyword, length)}) {
 836     open->set_convert(*convert);
 837     return true;
 838   } else {
 839     open->SignalError(IostatErrorInKeyword, "Invalid CONVERT='%.*s'",
 840         static_cast<int>(length), keyword);
 841     return false;
 842   }
 843 }
 844
 845 bool IODEF(SetEncoding)(
 846     Cookie cookie, const char *keyword, std::size_t length) {
 847   IoStatementState &io{*cookie};
 848   auto *open{io.get_if<OpenStatementState>()};
 849   if (!open) {
 850     if (!io.get_if<NoopStatementState>() &&
 851         !io.get_if<ErroneousIoStatementState>()) {
 852       io.GetIoErrorHandler().Crash(
 853           "SetEncoding() called when not in an OPEN statement");
 854     }
 855     return false;
 856   } else if (open->completedOperation()) {
 857     io.GetIoErrorHandler().Crash(
 858         "SetEncoding() called after GetNewUnit() for an OPEN statement");
 859   }
 860   // Allow the encoding to be changed on an open unit -- it's
 861   // useful and safe.
 862   static const char *keywords[]{"UTF-8", "DEFAULT", nullptr};
 863   switch (IdentifyValue(keyword, length, keywords)) {
 864   case 0:
 865     open->unit().isUTF8 = true;
 866     break;
 867   case 1:
 868     open->unit().isUTF8 = false;
 869     break;
 870   default:
 871     open->SignalError(IostatErrorInKeyword, "Invalid ENCODING='%.*s'",
 872         static_cast<int>(length), keyword);
 873   }
 874   return true;
 875 }
 876
 877 bool IODEF(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {
 878   IoStatementState &io{*cookie};
 879   auto *open{io.get_if<OpenStatementState>()};
 880   if (!open) {
 881     if (!io.get_if<NoopStatementState>() &&
 882         !io.get_if<ErroneousIoStatementState>()) {
 883       io.GetIoErrorHandler().Crash(
 884           "SetForm() called when not in an OPEN statement");
 885     }
 886   } else if (open->completedOperation()) {
 887     io.GetIoErrorHandler().Crash(
 888         "SetForm() called after GetNewUnit() for an OPEN statement");
 889   }
 890   static const char *keywords[]{"FORMATTED", "UNFORMATTED", "BINARY", nullptr};
 891   switch (IdentifyValue(keyword, length, keywords)) {
 892   case 0:
 893     open->set_isUnformatted(false);
 894     break;
 895   case 1:
 896     open->set_isUnformatted(true);
 897     break;
 898   case 2: // legacy FORM='BINARY' means an unformatted stream
 899     open->set_isUnformatted(true);
 900     open->set_access(Access::Stream);
 901     break;
 902   default:
 903     open->SignalError(IostatErrorInKeyword, "Invalid FORM='%.*s'",
 904         static_cast<int>(length), keyword);
 905   }
 906   return true;
 907 }
 908
 909 bool IODEF(SetPosition)(
 910     Cookie cookie, const char *keyword, std::size_t length) {
 911   IoStatementState &io{*cookie};
 912   auto *open{io.get_if<OpenStatementState>()};
 913   if (!open) {
 914     if (!io.get_if<NoopStatementState>() &&
 915         !io.get_if<ErroneousIoStatementState>()) {
 916       io.GetIoErrorHandler().Crash(
 917           "SetPosition() called when not in an OPEN statement");
 918     }
 919     return false;
 920   } else if (open->completedOperation()) {
 921     io.GetIoErrorHandler().Crash(
 922         "SetPosition() called after GetNewUnit() for an OPEN statement");
 923   }
 924   static const char *positions[]{"ASIS", "REWIND", "APPEND", nullptr};
 925   switch (IdentifyValue(keyword, length, positions)) {
 926   case 0:
 927     open->set_position(Position::AsIs);
 928     return true;
 929   case 1:
 930     open->set_position(Position::Rewind);
 931     return true;
 932   case 2:
 933     open->set_position(Position::Append);
 934     return true;
 935   default:
 936     io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
 937         "Invalid POSITION='%.*s'", static_cast<int>(length), keyword);
 938   }
 939   return true;
 940 }
 941
 942 bool IODEF(SetRecl)(Cookie cookie, std::size_t n) {
 943   IoStatementState &io{*cookie};
 944   auto *open{io.get_if<OpenStatementState>()};
 945   if (!open) {
 946     if (!io.get_if<NoopStatementState>() &&
 947         !io.get_if<ErroneousIoStatementState>()) {
 948       io.GetIoErrorHandler().Crash(
 949           "SetRecl() called when not in an OPEN statement");
 950     }
 951     return false;
 952   } else if (open->completedOperation()) {
 953     io.GetIoErrorHandler().Crash(
 954         "SetRecl() called after GetNewUnit() for an OPEN statement");
 955   }
 956   if (static_cast<std::int64_t>(n) <= 0) {
 957     io.GetIoErrorHandler().SignalError("RECL= must be greater than zero");
 958     return false;
 959   } else if (open->wasExtant() &&
 960       open->unit().openRecl.value_or(0) != static_cast<std::int64_t>(n)) {
 961     open->SignalError("RECL= may not be changed for an open unit");
 962     return false;
 963   } else {
 964     open->unit().openRecl = n;
 965     return true;
 966   }
 967 }
 968
 969 bool IODEF(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
 970   IoStatementState &io{*cookie};
 971   if (auto *open{io.get_if<OpenStatementState>()}) {
 972     if (open->completedOperation()) {
 973       io.GetIoErrorHandler().Crash(
 974           "SetStatus() called after GetNewUnit() for an OPEN statement");
 975     }
 976     static const char *statuses[]{
 977         "OLD", "NEW", "SCRATCH", "REPLACE", "UNKNOWN", nullptr};
 978     switch (IdentifyValue(keyword, length, statuses)) {
 979     case 0:
 980       open->set_status(OpenStatus::Old);
 981       return true;
 982     case 1:
 983       open->set_status(OpenStatus::New);
 984       return true;
 985     case 2:
 986       open->set_status(OpenStatus::Scratch);
 987       return true;
 988     case 3:
 989       open->set_status(OpenStatus::Replace);
 990       return true;
 991     case 4:
 992       open->set_status(OpenStatus::Unknown);
 993       return true;
 994     default:
 995       io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
 996           "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
 997     }
 998     return false;
 999   }
1000   if (auto *close{io.get_if<CloseStatementState>()}) {
1001     static const char *statuses[]{"KEEP", "DELETE", nullptr};
1002     switch (IdentifyValue(keyword, length, statuses)) {
1003     case 0:
1004       close->set_status(CloseStatus::Keep);
1005       return true;
1006     case 1:
1007       close->set_status(CloseStatus::Delete);
1008       return true;
1009     default:
1010       io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
1011           "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
1012     }
1013     return false;
1014   }
1015   if (io.get_if<NoopStatementState>() ||
1016       io.get_if<ErroneousIoStatementState>()) {
1017     return true; // don't bother validating STATUS= in a no-op CLOSE
1018   }
1019   io.GetIoErrorHandler().Crash(
1020       "SetStatus() called when not in an OPEN or CLOSE statement");
1021 }
1022
1023 bool IODEF(SetFile)(Cookie cookie, const char *path, std::size_t chars) {
1024   IoStatementState &io{*cookie};
1025   if (auto *open{io.get_if<OpenStatementState>()}) {
1026     if (open->completedOperation()) {
1027       io.GetIoErrorHandler().Crash(
1028           "SetFile() called after GetNewUnit() for an OPEN statement");
1029     }
1030     open->set_path(path, chars);
1031     return true;
1032   } else if (!io.get_if<NoopStatementState>() &&
1033       !io.get_if<ErroneousIoStatementState>()) {
1034     io.GetIoErrorHandler().Crash(
1035         "SetFile() called when not in an OPEN statement");
1036   }
1037   return false;
1038 }
1039
1040 bool IODEF(GetNewUnit)(Cookie cookie, int &unit, int kind) {
1041   IoStatementState &io{*cookie};
1042   auto *open{io.get_if<OpenStatementState>()};
1043   if (!open) {
1044     if (!io.get_if<NoopStatementState>() &&
1045         !io.get_if<ErroneousIoStatementState>()) {
1046       io.GetIoErrorHandler().Crash(
1047           "GetNewUnit() called when not in an OPEN statement");
1048     }
1049     return false;
1050   } else if (!open->InError()) {
1051     open->CompleteOperation();
1052   }
1053   if (open->InError()) {
1054     // A failed OPEN(NEWUNIT=n) does not modify 'n'
1055     return false;
1056   }
1057   std::int64_t result{open->unit().unitNumber()};
1058   if (!SetInteger(unit, kind, result)) {
1059     open->SignalError("GetNewUnit(): bad INTEGER kind(%d) or out-of-range "
1060                       "value(%jd) for result",
1061         kind, static_cast<std::intmax_t>(result));
1062   }
1063   return true;
1064 }
1065
1066 // Data transfers
1067
1068 bool IODEF(OutputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
1069   return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
1070 }
1071
1072 bool IODEF(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
1073   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1074 }
1075
1076 bool IODEF(InputInteger)(Cookie cookie, std::int64_t &n, int kind) {
1077   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputInteger")) {
1078     return false;
1079   }
1080   StaticDescriptor<0> staticDescriptor;
1081   Descriptor &descriptor{staticDescriptor.descriptor()};
1082   descriptor.Establish(
1083       TypeCategory::Integer, kind, reinterpret_cast<void *>(&n), 0);
1084   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1085 }
1086
1087 bool IODEF(InputReal32)(Cookie cookie, float &x) {
1088   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal32")) {
1089     return false;
1090   }
1091   StaticDescriptor<0> staticDescriptor;
1092   Descriptor &descriptor{staticDescriptor.descriptor()};
1093   descriptor.Establish(TypeCategory::Real, 4, reinterpret_cast<void *>(&x), 0);
1094   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1095 }
1096
1097 bool IODEF(InputReal64)(Cookie cookie, double &x) {
1098   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal64")) {
1099     return false;
1100   }
1101   StaticDescriptor<0> staticDescriptor;
1102   Descriptor &descriptor{staticDescriptor.descriptor()};
1103   descriptor.Establish(TypeCategory::Real, 8, reinterpret_cast<void *>(&x), 0);
1104   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1105 }
1106
1107 bool IODEF(InputComplex32)(Cookie cookie, float z[2]) {
1108   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex32")) {
1109     return false;
1110   }
1111   StaticDescriptor<0> staticDescriptor;
1112   Descriptor &descriptor{staticDescriptor.descriptor()};
1113   descriptor.Establish(
1114       TypeCategory::Complex, 4, reinterpret_cast<void *>(z), 0);
1115   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1116 }
1117
1118 bool IODEF(InputComplex64)(Cookie cookie, double z[2]) {
1119   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex64")) {
1120     return false;
1121   }
1122   StaticDescriptor<0> staticDescriptor;
1123   Descriptor &descriptor{staticDescriptor.descriptor()};
1124   descriptor.Establish(
1125       TypeCategory::Complex, 8, reinterpret_cast<void *>(z), 0);
1126   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1127 }
1128
1129 bool IODEF(OutputCharacter)(
1130     Cookie cookie, const char *x, std::size_t length, int kind) {
1131   if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputCharacter")) {
1132     return false;
1133   }
1134   StaticDescriptor<0> staticDescriptor;
1135   Descriptor &descriptor{staticDescriptor.descriptor()};
1136   descriptor.Establish(
1137       kind, length, reinterpret_cast<void *>(const_cast<char *>(x)), 0);
1138   return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
1139 }
1140
1141 bool IODEF(InputCharacter)(
1142     Cookie cookie, char *x, std::size_t length, int kind) {
1143   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputCharacter")) {
1144     return false;
1145   }
1146   StaticDescriptor<0> staticDescriptor;
1147   Descriptor &descriptor{staticDescriptor.descriptor()};
1148   descriptor.Establish(kind, length, reinterpret_cast<void *>(x), 0);
1149   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1150 }
1151
1152 bool IODEF(InputAscii)(Cookie cookie, char *x, std::size_t length) {
1153   return IONAME(InputCharacter)(cookie, x, length, 1);
1154 }
1155
1156 bool IODEF(InputLogical)(Cookie cookie, bool &truth) {
1157   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputLogical")) {
1158     return false;
1159   }
1160   StaticDescriptor<0> staticDescriptor;
1161   Descriptor &descriptor{staticDescriptor.descriptor()};
1162   descriptor.Establish(
1163       TypeCategory::Logical, sizeof truth, reinterpret_cast<void *>(&truth), 0);
1164   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1165 }
1166
1167 bool IODEF(OutputDerivedType)(Cookie cookie, const Descriptor &descriptor,
1168     const NonTbpDefinedIoTable *table) {
1169   return descr::DescriptorIO<Direction::Output>(*cookie, descriptor, table);
1170 }
1171
1172 bool IODEF(InputDerivedType)(Cookie cookie, const Descriptor &descriptor,
1173     const NonTbpDefinedIoTable *table) {
1174   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor, table);
1175 }
1176
1177 std::size_t IODEF(GetSize)(Cookie cookie) {
1178   IoStatementState &io{*cookie};
1179   IoErrorHandler &handler{io.GetIoErrorHandler()};
1180   if (!handler.InError()) {
1181     io.CompleteOperation();
1182   }
1183   if (const auto *formatted{
1184           io.get_if<FormattedIoStatementState<Direction::Input>>()}) {
1185     return formatted->GetEditDescriptorChars();
1186   } else if (!io.get_if<NoopStatementState>() &&
1187       !io.get_if<ErroneousIoStatementState>()) {
1188     handler.Crash("GetIoSize() called for an I/O statement that is not a "
1189                   "formatted READ()");
1190   }
1191   return 0;
1192 }
1193
1194 std::size_t IODEF(GetIoLength)(Cookie cookie) {
1195   IoStatementState &io{*cookie};
1196   IoErrorHandler &handler{io.GetIoErrorHandler()};
1197   if (!handler.InError()) {
1198     io.CompleteOperation();
1199   }
1200   if (const auto *inq{io.get_if<InquireIOLengthState>()}) {
1201     return inq->bytes();
1202   } else if (!io.get_if<NoopStatementState>() &&
1203       !io.get_if<ErroneousIoStatementState>()) {
1204     handler.Crash("GetIoLength() called for an I/O statement that is not "
1205                   "INQUIRE(IOLENGTH=)");
1206   }
1207   return 0;
1208 }
1209
1210 void IODEF(GetIoMsg)(Cookie cookie, char *msg, std::size_t length) {
1211   IoStatementState &io{*cookie};
1212   IoErrorHandler &handler{io.GetIoErrorHandler()};
1213   if (!handler.InError()) {
1214     io.CompleteOperation();
1215   }
1216   if (handler.InError()) { // leave "msg" alone when no error
1217     handler.GetIoMsg(msg, length);
1218   }
1219 }
1220
1221 AsynchronousId IODEF(GetAsynchronousId)(Cookie cookie) {
1222   IoStatementState &io{*cookie};
1223   IoErrorHandler &handler{io.GetIoErrorHandler()};
1224   if (auto *ext{io.get_if<ExternalIoStatementBase>()}) {
1225     return ext->asynchronousID();
1226   } else if (!io.get_if<NoopStatementState>() &&
1227       !io.get_if<ErroneousIoStatementState>()) {
1228     handler.Crash(
1229         "GetAsynchronousId() called when not in an external I/O statement");
1230   }
1231   return 0;
1232 }
1233
1234 bool IODEF(InquireCharacter)(Cookie cookie, InquiryKeywordHash inquiry,
1235     char *result, std::size_t length) {
1236   IoStatementState &io{*cookie};
1237   return io.Inquire(inquiry, result, length);
1238 }
1239
1240 bool IODEF(InquireLogical)(
1241     Cookie cookie, InquiryKeywordHash inquiry, bool &result) {
1242   IoStatementState &io{*cookie};
1243   return io.Inquire(inquiry, result);
1244 }
1245
1246 bool IODEF(InquirePendingId)(Cookie cookie, AsynchronousId id, bool &result) {
1247   IoStatementState &io{*cookie};
1248   return io.Inquire(HashInquiryKeyword("PENDING"), id, result);
1249 }
1250
1251 bool IODEF(InquireInteger64)(
1252     Cookie cookie, InquiryKeywordHash inquiry, std::int64_t &result, int kind) {
1253   IoStatementState &io{*cookie};
1254   std::int64_t n{0}; // safe "undefined" value
1255   if (io.Inquire(inquiry, n)) {
1256     if (SetInteger(result, kind, n)) {
1257       return true;
1258     }
1259     io.GetIoErrorHandler().SignalError(
1260         "InquireInteger64(): bad INTEGER kind(%d) or out-of-range "
1261         "value(%jd) for result",
1262         kind, static_cast<std::intmax_t>(n));
1263   }
1264   return false;
1265 }
1266
1267 template <typename INT>
1268 static RT_API_ATTRS enum Iostat CheckUnitNumberInRangeImpl(INT unit,
1269     bool handleError, char *ioMsg, std::size_t ioMsgLength,
1270     const char *sourceFile, int sourceLine) {
1271   static_assert(sizeof(INT) >= sizeof(ExternalUnit),
1272       "only intended to be used when the INT to ExternalUnit conversion is "
1273       "narrowing");
1274   if (unit != static_cast<ExternalUnit>(unit)) {
1275     Terminator oom{sourceFile, sourceLine};
1276     IoErrorHandler errorHandler{oom};
1277     if (handleError) {
1278       errorHandler.HasIoStat();
1279       if (ioMsg) {
1280         errorHandler.HasIoMsg();
1281       }
1282     }
1283     // Only provide the bad unit number in the message if SignalError can print
1284     // it accurately. Otherwise, the generic IostatUnitOverflow message will be
1285     // used.
1286     if constexpr (sizeof(INT) > sizeof(std::intmax_t)) {
1287       errorHandler.SignalError(IostatUnitOverflow);
1288     } else if (static_cast<std::intmax_t>(unit) == unit) {
1289       errorHandler.SignalError(IostatUnitOverflow,
1290           "UNIT number %jd is out of range", static_cast<std::intmax_t>(unit));
1291     } else {
1292       errorHandler.SignalError(IostatUnitOverflow);
1293     }
1294     if (ioMsg) {
1295       errorHandler.GetIoMsg(ioMsg, ioMsgLength);
1296     }
1297     return static_cast<enum Iostat>(errorHandler.GetIoStat());
1298   }
1299   return IostatOk;
1300 }
1301
1302 enum Iostat IODEF(CheckUnitNumberInRange64)(std::int64_t unit, bool handleError,
1303     char *ioMsg, std::size_t ioMsgLength, const char *sourceFile,
1304     int sourceLine) {
1305   return CheckUnitNumberInRangeImpl(
1306       unit, handleError, ioMsg, ioMsgLength, sourceFile, sourceLine);
1307 }
1308
1309 #ifdef __SIZEOF_INT128__
1310 enum Iostat IODEF(CheckUnitNumberInRange128)(common::int128_t unit,
1311     bool handleError, char *ioMsg, std::size_t ioMsgLength,
1312     const char *sourceFile, int sourceLine) {
1313   return CheckUnitNumberInRangeImpl(
1314       unit, handleError, ioMsg, ioMsgLength, sourceFile, sourceLine);
1315 }
1316 #endif
1317
1318 RT_EXT_API_GROUP_END
1319 } // namespace Fortran::runtime::io