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