xref: /llvm-project/flang/runtime/io-api.cpp (revision f3c31d7040582bf1b1c7a3e0ddd9d3f49b4b7f31) 
1 //===-- runtime/io-api.cpp ------------------------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 // Implements the I/O statement API
10 
11 #include "flang/Runtime/io-api.h"
12 #include "descriptor-io.h"
13 #include "edit-input.h"
14 #include "edit-output.h"
15 #include "environment.h"
16 #include "format.h"
17 #include "io-stmt.h"
18 #include "terminator.h"
19 #include "tools.h"
20 #include "unit.h"
21 #include "flang/Common/optional.h"
22 #include "flang/Runtime/descriptor.h"
23 #include "flang/Runtime/memory.h"
24 #include <cstdlib>
25 #include <memory>
26 
27 namespace Fortran::runtime::io {
28 RT_EXT_API_GROUP_BEGIN
29 
30 RT_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 
47 template <Direction DIR>
48 RT_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 
58 Cookie 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 
65 Cookie 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 
72 template <Direction DIR>
73 RT_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 
84 Cookie 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 
93 Cookie 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 
102 template <Direction DIR>
103 RT_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 
114 Cookie 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 
121 Cookie 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 
128 template <Direction DIR>
129 RT_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 
142 Cookie 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 
151 Cookie 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 
160 static 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 
172 static 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 
186 template <Direction DIR, template <Direction> class STATE, typename... A>
187 RT_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 
231 Cookie IODEF(BeginExternalListOutput)(
232     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
233   return BeginExternalListIO<Direction::Output, ExternalListIoStatementState>(
234       unitNumber, sourceFile, sourceLine);
235 }
236 
237 Cookie IODEF(BeginExternalListInput)(
238     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
239   return BeginExternalListIO<Direction::Input, ExternalListIoStatementState>(
240       unitNumber, sourceFile, sourceLine);
241 }
242 
243 template <Direction DIR>
244 RT_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 
288 Cookie 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 
295 Cookie 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 
302 template <Direction DIR>
303 RT_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 
354 Cookie IODEF(BeginUnformattedOutput)(
355     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
356   return BeginUnformattedIO<Direction::Output>(
357       unitNumber, sourceFile, sourceLine);
358 }
359 
360 Cookie IODEF(BeginUnformattedInput)(
361     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
362   return BeginUnformattedIO<Direction::Input>(
363       unitNumber, sourceFile, sourceLine);
364 }
365 
366 Cookie 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 
386 Cookie 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 
396 Cookie 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 }
412 Cookie IODEF(BeginWaitAll)(
413     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
414   return IONAME(BeginWait)(unitNumber, 0 /*no ID=*/, sourceFile, sourceLine);
415 }
416 
417 Cookie 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 
436 Cookie 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 
454 Cookie 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 
472 Cookie 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 
492 Cookie 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 
512 Cookie 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 
532 Cookie 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 
556 Cookie 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 
565 void 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 
585 static 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(keyword, length, 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 
600 bool 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 
617 bool 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 
634 bool 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 
651 bool 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 
671 bool 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 
678 bool 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 
689 bool 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 
705 bool 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 
735 bool 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 
754 bool 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 
790 bool 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 
832 bool 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 
859 bool 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 
891 bool 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 
915 bool 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 
947 bool 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 
975 bool 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 
1008 bool 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 
1035 bool 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 
1089 bool 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 
1106 bool 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 
1134 bool IODEF(OutputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
1135   return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
1136 }
1137 
1138 bool IODEF(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
1139   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1140 }
1141 
1142 bool 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 
1153 bool 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 
1164 bool 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 
1175 bool 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__
1187 bool 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 
1199 bool 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 
1210 bool 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 
1220 bool 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 
1230 bool 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 
1240 bool 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 
1250 bool 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 
1262 bool 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 
1274 bool 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 
1285 bool 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 
1296 bool 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 
1308 bool IODEF(OutputAscii)(Cookie cookie, const char *x, std::size_t length) {
1309   return IONAME(OutputCharacter(cookie, x, length, 1));
1310 }
1311 
1312 bool 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 
1323 bool IODEF(InputAscii)(Cookie cookie, char *x, std::size_t length) {
1324   return IONAME(InputCharacter)(cookie, x, length, 1);
1325 }
1326 
1327 bool 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 
1338 bool 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 
1349 bool IODEF(OutputDerivedType)(Cookie cookie, const Descriptor &descriptor,
1350     const NonTbpDefinedIoTable *table) {
1351   return descr::DescriptorIO<Direction::Output>(*cookie, descriptor, table);
1352 }
1353 
1354 bool IODEF(InputDerivedType)(Cookie cookie, const Descriptor &descriptor,
1355     const NonTbpDefinedIoTable *table) {
1356   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor, table);
1357 }
1358 
1359 std::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 
1376 std::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 
1392 void 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 
1403 AsynchronousId 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 
1416 bool 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 
1422 bool IODEF(InquireLogical)(
1423     Cookie cookie, InquiryKeywordHash inquiry, bool &result) {
1424   IoStatementState &io{*cookie};
1425   return io.Inquire(inquiry, result);
1426 }
1427 
1428 bool IODEF(InquirePendingId)(Cookie cookie, AsynchronousId id, bool &result) {
1429   IoStatementState &io{*cookie};
1430   return io.Inquire(HashInquiryKeyword("PENDING"), id, result);
1431 }
1432 
1433 bool 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 
1449 enum Iostat IODEF(EndIoStatement)(Cookie cookie) {
1450   IoStatementState &io{*cookie};
1451   return static_cast<enum Iostat>(io.EndIoStatement());
1452 }
1453 
1454 template <typename INT>
1455 static 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 
1489 enum 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__
1497 enum 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 
1511 void 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 
1521 RT_EXT_API_GROUP_END
1522