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

source code of flang-rt/lib/runtime/io-api.cpp