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