xref: /llvm-project/flang/runtime/io-api.cpp (revision fee393e4ea2b53139ee7924e3aa818433d70cfc7)
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       handler.HasRec();
627       unit->SetDirectRec(rec, handler);
628     }
629   } else if (!io.get_if<ErroneousIoStatementState>()) {
630     handler.Crash("SetRec() called on internal unit");
631   }
632   return true;
633 }
634 
635 bool IODEF(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
636   IoStatementState &io{*cookie};
637   static const char *keywords[]{"UP", "DOWN", "ZERO", "NEAREST", "COMPATIBLE",
638       "PROCESSOR_DEFINED", nullptr};
639   switch (IdentifyValue(keyword, length, keywords)) {
640   case 0:
641     io.mutableModes().round = decimal::RoundUp;
642     return true;
643   case 1:
644     io.mutableModes().round = decimal::RoundDown;
645     return true;
646   case 2:
647     io.mutableModes().round = decimal::RoundToZero;
648     return true;
649   case 3:
650     io.mutableModes().round = decimal::RoundNearest;
651     return true;
652   case 4:
653     io.mutableModes().round = decimal::RoundCompatible;
654     return true;
655   case 5:
656     io.mutableModes().round = executionEnvironment.defaultOutputRoundingMode;
657     return true;
658   default:
659     io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
660         "Invalid ROUND='%.*s'", static_cast<int>(length), keyword);
661     return false;
662   }
663 }
664 
665 bool IODEF(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {
666   IoStatementState &io{*cookie};
667   static const char *keywords[]{
668       "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", nullptr};
669   switch (IdentifyValue(keyword, length, keywords)) {
670   case 0:
671     io.mutableModes().editingFlags |= signPlus;
672     return true;
673   case 1:
674   case 2: // processor default is SS
675     io.mutableModes().editingFlags &= ~signPlus;
676     return true;
677   default:
678     io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
679         "Invalid SIGN='%.*s'", static_cast<int>(length), keyword);
680     return false;
681   }
682 }
683 
684 bool IODEF(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {
685   IoStatementState &io{*cookie};
686   auto *open{io.get_if<OpenStatementState>()};
687   if (!open) {
688     if (!io.get_if<NoopStatementState>() &&
689         !io.get_if<ErroneousIoStatementState>()) {
690       io.GetIoErrorHandler().Crash(
691           "SetAccess() called when not in an OPEN statement");
692     }
693     return false;
694   } else if (open->completedOperation()) {
695     io.GetIoErrorHandler().Crash(
696         "SetAccess() called after GetNewUnit() for an OPEN statement");
697   }
698   static const char *keywords[]{
699       "SEQUENTIAL", "DIRECT", "STREAM", "APPEND", nullptr};
700   switch (IdentifyValue(keyword, length, keywords)) {
701   case 0:
702     open->set_access(Access::Sequential);
703     break;
704   case 1:
705     open->set_access(Access::Direct);
706     break;
707   case 2:
708     open->set_access(Access::Stream);
709     break;
710   case 3: // Sun Fortran extension ACCESS=APPEND: treat as if POSITION=APPEND
711     open->set_position(Position::Append);
712     break;
713   default:
714     open->SignalError(IostatErrorInKeyword, "Invalid ACCESS='%.*s'",
715         static_cast<int>(length), keyword);
716   }
717   return true;
718 }
719 
720 bool IODEF(SetAction)(Cookie cookie, const char *keyword, std::size_t length) {
721   IoStatementState &io{*cookie};
722   auto *open{io.get_if<OpenStatementState>()};
723   if (!open) {
724     if (!io.get_if<NoopStatementState>() &&
725         !io.get_if<ErroneousIoStatementState>()) {
726       io.GetIoErrorHandler().Crash(
727           "SetAction() called when not in an OPEN statement");
728     }
729     return false;
730   } else if (open->completedOperation()) {
731     io.GetIoErrorHandler().Crash(
732         "SetAction() called after GetNewUnit() for an OPEN statement");
733   }
734   Fortran::common::optional<Action> action;
735   static const char *keywords[]{"READ", "WRITE", "READWRITE", nullptr};
736   switch (IdentifyValue(keyword, length, keywords)) {
737   case 0:
738     action = Action::Read;
739     break;
740   case 1:
741     action = Action::Write;
742     break;
743   case 2:
744     action = Action::ReadWrite;
745     break;
746   default:
747     open->SignalError(IostatErrorInKeyword, "Invalid ACTION='%.*s'",
748         static_cast<int>(length), keyword);
749     return false;
750   }
751   RUNTIME_CHECK(io.GetIoErrorHandler(), action.has_value());
752   if (open->wasExtant()) {
753     if ((*action != Action::Write) != open->unit().mayRead() ||
754         (*action != Action::Read) != open->unit().mayWrite()) {
755       open->SignalError("ACTION= may not be changed on an open unit");
756     }
757   }
758   open->set_action(*action);
759   return true;
760 }
761 
762 bool IODEF(SetAsynchronous)(
763     Cookie cookie, const char *keyword, std::size_t length) {
764   IoStatementState &io{*cookie};
765   IoErrorHandler &handler{io.GetIoErrorHandler()};
766   bool isYes{YesOrNo(keyword, length, "ASYNCHRONOUS", handler)};
767   if (auto *open{io.get_if<OpenStatementState>()}) {
768     if (open->completedOperation()) {
769       handler.Crash(
770           "SetAsynchronous() called after GetNewUnit() for an OPEN statement");
771     }
772     open->unit().set_mayAsynchronous(isYes);
773   } else if (!isYes) {
774     // ASYNCHRONOUS='NO' is the default, so this is a no-op
775   } else if (auto *ext{io.get_if<ExternalIoStatementBase>()}) {
776     if (ext->unit().mayAsynchronous()) {
777       ext->SetAsynchronous();
778     } else {
779       handler.SignalError(IostatBadAsynchronous);
780     }
781   } else if (!io.get_if<NoopStatementState>() &&
782       !io.get_if<ErroneousIoStatementState>()) {
783     handler.Crash("SetAsynchronous('YES') called when not in an OPEN or "
784                   "external I/O statement");
785   }
786   return !handler.InError();
787 }
788 
789 bool IODEF(SetCarriagecontrol)(
790     Cookie cookie, const char *keyword, std::size_t length) {
791   IoStatementState &io{*cookie};
792   auto *open{io.get_if<OpenStatementState>()};
793   if (!open) {
794     if (!io.get_if<NoopStatementState>() &&
795         !io.get_if<ErroneousIoStatementState>()) {
796       io.GetIoErrorHandler().Crash(
797           "SetCarriageControl() called when not in an OPEN statement");
798     }
799     return false;
800   } else if (open->completedOperation()) {
801     io.GetIoErrorHandler().Crash(
802         "SetCarriageControl() called after GetNewUnit() for an OPEN statement");
803   }
804   static const char *keywords[]{"LIST", "FORTRAN", "NONE", nullptr};
805   switch (IdentifyValue(keyword, length, keywords)) {
806   case 0:
807     return true;
808   case 1:
809   case 2:
810     open->SignalError(IostatErrorInKeyword,
811         "Unimplemented CARRIAGECONTROL='%.*s'", static_cast<int>(length),
812         keyword);
813     return false;
814   default:
815     open->SignalError(IostatErrorInKeyword, "Invalid CARRIAGECONTROL='%.*s'",
816         static_cast<int>(length), keyword);
817     return false;
818   }
819 }
820 
821 bool IODEF(SetConvert)(Cookie cookie, const char *keyword, std::size_t length) {
822   IoStatementState &io{*cookie};
823   auto *open{io.get_if<OpenStatementState>()};
824   if (!open) {
825     if (!io.get_if<NoopStatementState>() &&
826         !io.get_if<ErroneousIoStatementState>()) {
827       io.GetIoErrorHandler().Crash(
828           "SetConvert() called when not in an OPEN statement");
829     }
830     return false;
831   } else if (open->completedOperation()) {
832     io.GetIoErrorHandler().Crash(
833         "SetConvert() called after GetNewUnit() for an OPEN statement");
834   }
835   if (auto convert{GetConvertFromString(keyword, length)}) {
836     open->set_convert(*convert);
837     return true;
838   } else {
839     open->SignalError(IostatErrorInKeyword, "Invalid CONVERT='%.*s'",
840         static_cast<int>(length), keyword);
841     return false;
842   }
843 }
844 
845 bool IODEF(SetEncoding)(
846     Cookie cookie, const char *keyword, std::size_t length) {
847   IoStatementState &io{*cookie};
848   auto *open{io.get_if<OpenStatementState>()};
849   if (!open) {
850     if (!io.get_if<NoopStatementState>() &&
851         !io.get_if<ErroneousIoStatementState>()) {
852       io.GetIoErrorHandler().Crash(
853           "SetEncoding() called when not in an OPEN statement");
854     }
855     return false;
856   } else if (open->completedOperation()) {
857     io.GetIoErrorHandler().Crash(
858         "SetEncoding() called after GetNewUnit() for an OPEN statement");
859   }
860   // Allow the encoding to be changed on an open unit -- it's
861   // useful and safe.
862   static const char *keywords[]{"UTF-8", "DEFAULT", nullptr};
863   switch (IdentifyValue(keyword, length, keywords)) {
864   case 0:
865     open->unit().isUTF8 = true;
866     break;
867   case 1:
868     open->unit().isUTF8 = false;
869     break;
870   default:
871     open->SignalError(IostatErrorInKeyword, "Invalid ENCODING='%.*s'",
872         static_cast<int>(length), keyword);
873   }
874   return true;
875 }
876 
877 bool IODEF(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {
878   IoStatementState &io{*cookie};
879   auto *open{io.get_if<OpenStatementState>()};
880   if (!open) {
881     if (!io.get_if<NoopStatementState>() &&
882         !io.get_if<ErroneousIoStatementState>()) {
883       io.GetIoErrorHandler().Crash(
884           "SetForm() called when not in an OPEN statement");
885     }
886   } else if (open->completedOperation()) {
887     io.GetIoErrorHandler().Crash(
888         "SetForm() called after GetNewUnit() for an OPEN statement");
889   }
890   static const char *keywords[]{"FORMATTED", "UNFORMATTED", nullptr};
891   switch (IdentifyValue(keyword, length, keywords)) {
892   case 0:
893     open->set_isUnformatted(false);
894     break;
895   case 1:
896     open->set_isUnformatted(true);
897     break;
898   default:
899     open->SignalError(IostatErrorInKeyword, "Invalid FORM='%.*s'",
900         static_cast<int>(length), keyword);
901   }
902   return true;
903 }
904 
905 bool IODEF(SetPosition)(
906     Cookie cookie, const char *keyword, std::size_t length) {
907   IoStatementState &io{*cookie};
908   auto *open{io.get_if<OpenStatementState>()};
909   if (!open) {
910     if (!io.get_if<NoopStatementState>() &&
911         !io.get_if<ErroneousIoStatementState>()) {
912       io.GetIoErrorHandler().Crash(
913           "SetPosition() called when not in an OPEN statement");
914     }
915     return false;
916   } else if (open->completedOperation()) {
917     io.GetIoErrorHandler().Crash(
918         "SetPosition() called after GetNewUnit() for an OPEN statement");
919   }
920   static const char *positions[]{"ASIS", "REWIND", "APPEND", nullptr};
921   switch (IdentifyValue(keyword, length, positions)) {
922   case 0:
923     open->set_position(Position::AsIs);
924     return true;
925   case 1:
926     open->set_position(Position::Rewind);
927     return true;
928   case 2:
929     open->set_position(Position::Append);
930     return true;
931   default:
932     io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
933         "Invalid POSITION='%.*s'", static_cast<int>(length), keyword);
934   }
935   return true;
936 }
937 
938 bool IODEF(SetRecl)(Cookie cookie, std::size_t n) {
939   IoStatementState &io{*cookie};
940   auto *open{io.get_if<OpenStatementState>()};
941   if (!open) {
942     if (!io.get_if<NoopStatementState>() &&
943         !io.get_if<ErroneousIoStatementState>()) {
944       io.GetIoErrorHandler().Crash(
945           "SetRecl() called when not in an OPEN statement");
946     }
947     return false;
948   } else if (open->completedOperation()) {
949     io.GetIoErrorHandler().Crash(
950         "SetRecl() called after GetNewUnit() for an OPEN statement");
951   }
952   if (static_cast<std::int64_t>(n) <= 0) {
953     io.GetIoErrorHandler().SignalError("RECL= must be greater than zero");
954     return false;
955   } else if (open->wasExtant() &&
956       open->unit().openRecl.value_or(0) != static_cast<std::int64_t>(n)) {
957     open->SignalError("RECL= may not be changed for an open unit");
958     return false;
959   } else {
960     open->unit().openRecl = n;
961     return true;
962   }
963 }
964 
965 bool IODEF(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
966   IoStatementState &io{*cookie};
967   if (auto *open{io.get_if<OpenStatementState>()}) {
968     if (open->completedOperation()) {
969       io.GetIoErrorHandler().Crash(
970           "SetStatus() called after GetNewUnit() for an OPEN statement");
971     }
972     static const char *statuses[]{
973         "OLD", "NEW", "SCRATCH", "REPLACE", "UNKNOWN", nullptr};
974     switch (IdentifyValue(keyword, length, statuses)) {
975     case 0:
976       open->set_status(OpenStatus::Old);
977       return true;
978     case 1:
979       open->set_status(OpenStatus::New);
980       return true;
981     case 2:
982       open->set_status(OpenStatus::Scratch);
983       return true;
984     case 3:
985       open->set_status(OpenStatus::Replace);
986       return true;
987     case 4:
988       open->set_status(OpenStatus::Unknown);
989       return true;
990     default:
991       io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
992           "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
993     }
994     return false;
995   }
996   if (auto *close{io.get_if<CloseStatementState>()}) {
997     static const char *statuses[]{"KEEP", "DELETE", nullptr};
998     switch (IdentifyValue(keyword, length, statuses)) {
999     case 0:
1000       close->set_status(CloseStatus::Keep);
1001       return true;
1002     case 1:
1003       close->set_status(CloseStatus::Delete);
1004       return true;
1005     default:
1006       io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
1007           "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
1008     }
1009     return false;
1010   }
1011   if (io.get_if<NoopStatementState>() ||
1012       io.get_if<ErroneousIoStatementState>()) {
1013     return true; // don't bother validating STATUS= in a no-op CLOSE
1014   }
1015   io.GetIoErrorHandler().Crash(
1016       "SetStatus() called when not in an OPEN or CLOSE statement");
1017 }
1018 
1019 bool IODEF(SetFile)(Cookie cookie, const char *path, std::size_t chars) {
1020   IoStatementState &io{*cookie};
1021   if (auto *open{io.get_if<OpenStatementState>()}) {
1022     if (open->completedOperation()) {
1023       io.GetIoErrorHandler().Crash(
1024           "SetFile() called after GetNewUnit() for an OPEN statement");
1025     }
1026     open->set_path(path, chars);
1027     return true;
1028   } else if (!io.get_if<NoopStatementState>() &&
1029       !io.get_if<ErroneousIoStatementState>()) {
1030     io.GetIoErrorHandler().Crash(
1031         "SetFile() called when not in an OPEN statement");
1032   }
1033   return false;
1034 }
1035 
1036 bool IODEF(GetNewUnit)(Cookie cookie, int &unit, int kind) {
1037   IoStatementState &io{*cookie};
1038   auto *open{io.get_if<OpenStatementState>()};
1039   if (!open) {
1040     if (!io.get_if<NoopStatementState>() &&
1041         !io.get_if<ErroneousIoStatementState>()) {
1042       io.GetIoErrorHandler().Crash(
1043           "GetNewUnit() called when not in an OPEN statement");
1044     }
1045     return false;
1046   } else if (!open->InError()) {
1047     open->CompleteOperation();
1048   }
1049   if (open->InError()) {
1050     // A failed OPEN(NEWUNIT=n) does not modify 'n'
1051     return false;
1052   }
1053   std::int64_t result{open->unit().unitNumber()};
1054   if (!SetInteger(unit, kind, result)) {
1055     open->SignalError("GetNewUnit(): bad INTEGER kind(%d) or out-of-range "
1056                       "value(%jd) for result",
1057         kind, static_cast<std::intmax_t>(result));
1058   }
1059   return true;
1060 }
1061 
1062 // Data transfers
1063 
1064 bool IODEF(OutputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
1065   return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
1066 }
1067 
1068 bool IODEF(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
1069   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1070 }
1071 
1072 bool IODEF(InputInteger)(Cookie cookie, std::int64_t &n, int kind) {
1073   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputInteger")) {
1074     return false;
1075   }
1076   StaticDescriptor<0> staticDescriptor;
1077   Descriptor &descriptor{staticDescriptor.descriptor()};
1078   descriptor.Establish(
1079       TypeCategory::Integer, kind, reinterpret_cast<void *>(&n), 0);
1080   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1081 }
1082 
1083 bool IODEF(InputReal32)(Cookie cookie, float &x) {
1084   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal32")) {
1085     return false;
1086   }
1087   StaticDescriptor<0> staticDescriptor;
1088   Descriptor &descriptor{staticDescriptor.descriptor()};
1089   descriptor.Establish(TypeCategory::Real, 4, reinterpret_cast<void *>(&x), 0);
1090   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1091 }
1092 
1093 bool IODEF(InputReal64)(Cookie cookie, double &x) {
1094   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal64")) {
1095     return false;
1096   }
1097   StaticDescriptor<0> staticDescriptor;
1098   Descriptor &descriptor{staticDescriptor.descriptor()};
1099   descriptor.Establish(TypeCategory::Real, 8, reinterpret_cast<void *>(&x), 0);
1100   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1101 }
1102 
1103 bool IODEF(InputComplex32)(Cookie cookie, float z[2]) {
1104   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex32")) {
1105     return false;
1106   }
1107   StaticDescriptor<0> staticDescriptor;
1108   Descriptor &descriptor{staticDescriptor.descriptor()};
1109   descriptor.Establish(
1110       TypeCategory::Complex, 4, reinterpret_cast<void *>(z), 0);
1111   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1112 }
1113 
1114 bool IODEF(InputComplex64)(Cookie cookie, double z[2]) {
1115   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex64")) {
1116     return false;
1117   }
1118   StaticDescriptor<0> staticDescriptor;
1119   Descriptor &descriptor{staticDescriptor.descriptor()};
1120   descriptor.Establish(
1121       TypeCategory::Complex, 8, reinterpret_cast<void *>(z), 0);
1122   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1123 }
1124 
1125 bool IODEF(OutputCharacter)(
1126     Cookie cookie, const char *x, std::size_t length, int kind) {
1127   if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputCharacter")) {
1128     return false;
1129   }
1130   StaticDescriptor<0> staticDescriptor;
1131   Descriptor &descriptor{staticDescriptor.descriptor()};
1132   descriptor.Establish(
1133       kind, length, reinterpret_cast<void *>(const_cast<char *>(x)), 0);
1134   return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
1135 }
1136 
1137 bool IODEF(InputCharacter)(
1138     Cookie cookie, char *x, std::size_t length, int kind) {
1139   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputCharacter")) {
1140     return false;
1141   }
1142   StaticDescriptor<0> staticDescriptor;
1143   Descriptor &descriptor{staticDescriptor.descriptor()};
1144   descriptor.Establish(kind, length, reinterpret_cast<void *>(x), 0);
1145   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1146 }
1147 
1148 bool IODEF(InputAscii)(Cookie cookie, char *x, std::size_t length) {
1149   return IONAME(InputCharacter)(cookie, x, length, 1);
1150 }
1151 
1152 bool IODEF(InputLogical)(Cookie cookie, bool &truth) {
1153   if (!cookie->CheckFormattedStmtType<Direction::Input>("InputLogical")) {
1154     return false;
1155   }
1156   StaticDescriptor<0> staticDescriptor;
1157   Descriptor &descriptor{staticDescriptor.descriptor()};
1158   descriptor.Establish(
1159       TypeCategory::Logical, sizeof truth, reinterpret_cast<void *>(&truth), 0);
1160   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1161 }
1162 
1163 bool IODEF(OutputDerivedType)(Cookie cookie, const Descriptor &descriptor,
1164     const NonTbpDefinedIoTable *table) {
1165   return descr::DescriptorIO<Direction::Output>(*cookie, descriptor, table);
1166 }
1167 
1168 bool IODEF(InputDerivedType)(Cookie cookie, const Descriptor &descriptor,
1169     const NonTbpDefinedIoTable *table) {
1170   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor, table);
1171 }
1172 
1173 std::size_t IODEF(GetSize)(Cookie cookie) {
1174   IoStatementState &io{*cookie};
1175   IoErrorHandler &handler{io.GetIoErrorHandler()};
1176   if (!handler.InError()) {
1177     io.CompleteOperation();
1178   }
1179   if (const auto *formatted{
1180           io.get_if<FormattedIoStatementState<Direction::Input>>()}) {
1181     return formatted->GetEditDescriptorChars();
1182   } else if (!io.get_if<NoopStatementState>() &&
1183       !io.get_if<ErroneousIoStatementState>()) {
1184     handler.Crash("GetIoSize() called for an I/O statement that is not a "
1185                   "formatted READ()");
1186   }
1187   return 0;
1188 }
1189 
1190 std::size_t IODEF(GetIoLength)(Cookie cookie) {
1191   IoStatementState &io{*cookie};
1192   IoErrorHandler &handler{io.GetIoErrorHandler()};
1193   if (!handler.InError()) {
1194     io.CompleteOperation();
1195   }
1196   if (const auto *inq{io.get_if<InquireIOLengthState>()}) {
1197     return inq->bytes();
1198   } else if (!io.get_if<NoopStatementState>() &&
1199       !io.get_if<ErroneousIoStatementState>()) {
1200     handler.Crash("GetIoLength() called for an I/O statement that is not "
1201                   "INQUIRE(IOLENGTH=)");
1202   }
1203   return 0;
1204 }
1205 
1206 void IODEF(GetIoMsg)(Cookie cookie, char *msg, std::size_t length) {
1207   IoStatementState &io{*cookie};
1208   IoErrorHandler &handler{io.GetIoErrorHandler()};
1209   if (!handler.InError()) {
1210     io.CompleteOperation();
1211   }
1212   if (handler.InError()) { // leave "msg" alone when no error
1213     handler.GetIoMsg(msg, length);
1214   }
1215 }
1216 
1217 AsynchronousId IODEF(GetAsynchronousId)(Cookie cookie) {
1218   IoStatementState &io{*cookie};
1219   IoErrorHandler &handler{io.GetIoErrorHandler()};
1220   if (auto *ext{io.get_if<ExternalIoStatementBase>()}) {
1221     return ext->asynchronousID();
1222   } else if (!io.get_if<NoopStatementState>() &&
1223       !io.get_if<ErroneousIoStatementState>()) {
1224     handler.Crash(
1225         "GetAsynchronousId() called when not in an external I/O statement");
1226   }
1227   return 0;
1228 }
1229 
1230 bool IODEF(InquireCharacter)(Cookie cookie, InquiryKeywordHash inquiry,
1231     char *result, std::size_t length) {
1232   IoStatementState &io{*cookie};
1233   return io.Inquire(inquiry, result, length);
1234 }
1235 
1236 bool IODEF(InquireLogical)(
1237     Cookie cookie, InquiryKeywordHash inquiry, bool &result) {
1238   IoStatementState &io{*cookie};
1239   return io.Inquire(inquiry, result);
1240 }
1241 
1242 bool IODEF(InquirePendingId)(Cookie cookie, AsynchronousId id, bool &result) {
1243   IoStatementState &io{*cookie};
1244   return io.Inquire(HashInquiryKeyword("PENDING"), id, result);
1245 }
1246 
1247 bool IODEF(InquireInteger64)(
1248     Cookie cookie, InquiryKeywordHash inquiry, std::int64_t &result, int kind) {
1249   IoStatementState &io{*cookie};
1250   std::int64_t n{0}; // safe "undefined" value
1251   if (io.Inquire(inquiry, n)) {
1252     if (SetInteger(result, kind, n)) {
1253       return true;
1254     }
1255     io.GetIoErrorHandler().SignalError(
1256         "InquireInteger64(): bad INTEGER kind(%d) or out-of-range "
1257         "value(%jd) for result",
1258         kind, static_cast<std::intmax_t>(n));
1259   }
1260   return false;
1261 }
1262 
1263 template <typename INT>
1264 static RT_API_ATTRS enum Iostat CheckUnitNumberInRangeImpl(INT unit,
1265     bool handleError, char *ioMsg, std::size_t ioMsgLength,
1266     const char *sourceFile, int sourceLine) {
1267   static_assert(sizeof(INT) >= sizeof(ExternalUnit),
1268       "only intended to be used when the INT to ExternalUnit conversion is "
1269       "narrowing");
1270   if (unit != static_cast<ExternalUnit>(unit)) {
1271     Terminator oom{sourceFile, sourceLine};
1272     IoErrorHandler errorHandler{oom};
1273     if (handleError) {
1274       errorHandler.HasIoStat();
1275       if (ioMsg) {
1276         errorHandler.HasIoMsg();
1277       }
1278     }
1279     // Only provide the bad unit number in the message if SignalError can print
1280     // it accurately. Otherwise, the generic IostatUnitOverflow message will be
1281     // used.
1282     if constexpr (sizeof(INT) > sizeof(std::intmax_t)) {
1283       errorHandler.SignalError(IostatUnitOverflow);
1284     } else if (static_cast<std::intmax_t>(unit) == unit) {
1285       errorHandler.SignalError(IostatUnitOverflow,
1286           "UNIT number %jd is out of range", static_cast<std::intmax_t>(unit));
1287     } else {
1288       errorHandler.SignalError(IostatUnitOverflow);
1289     }
1290     if (ioMsg) {
1291       errorHandler.GetIoMsg(ioMsg, ioMsgLength);
1292     }
1293     return static_cast<enum Iostat>(errorHandler.GetIoStat());
1294   }
1295   return IostatOk;
1296 }
1297 
1298 enum Iostat IODEF(CheckUnitNumberInRange64)(std::int64_t unit, bool handleError,
1299     char *ioMsg, std::size_t ioMsgLength, const char *sourceFile,
1300     int sourceLine) {
1301   return CheckUnitNumberInRangeImpl(
1302       unit, handleError, ioMsg, ioMsgLength, sourceFile, sourceLine);
1303 }
1304 
1305 #ifdef __SIZEOF_INT128__
1306 enum Iostat IODEF(CheckUnitNumberInRange128)(common::int128_t unit,
1307     bool handleError, char *ioMsg, std::size_t ioMsgLength,
1308     const char *sourceFile, int sourceLine) {
1309   return CheckUnitNumberInRangeImpl(
1310       unit, handleError, ioMsg, ioMsgLength, sourceFile, sourceLine);
1311 }
1312 #endif
1313 
1314 RT_EXT_API_GROUP_END
1315 } // namespace Fortran::runtime::io
1316