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