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