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