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