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

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