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

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