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