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