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