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