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