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