llvm-project

1
//===-- runtime/io-api.cpp ------------------------------------------------===//
2
//
3
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4
// See https://llvm.org/LICENSE.txt for license information.
5
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6
//
7
//===----------------------------------------------------------------------===//
8

9
// Implements the I/O statement API
10

11
// template function BeginExternalListIo<> is in runtime/io-api-common.h.
12
// APIs BeginExternalListOutput, OutputInteger{8,16,32,64,128},
13
// OutputReal{32,64}, OutputComplex{32,64}, OutputAscii, & EndIoStatement()
14
// are in runtime/io-api-minimal.cpp.
15

16
#include "flang/Runtime/io-api.h"
17
#include "descriptor-io.h"
18
#include "edit-input.h"
19
#include "edit-output.h"
20
#include "environment.h"
21
#include "format.h"
22
#include "io-api-common.h"
23
#include "io-stmt.h"
24
#include "terminator.h"
25
#include "tools.h"
26
#include "unit.h"
27
#include "flang/Common/optional.h"
28
#include "flang/Runtime/descriptor.h"
29
#include "flang/Runtime/memory.h"
30
#include <cstdlib>
31
#include <memory>
32

33
namespace Fortran::runtime::io {
34
RT_EXT_API_GROUP_BEGIN
35

36
RT_API_ATTRS const char *InquiryKeywordHashDecode(
37
    char *buffer, std::size_t n, InquiryKeywordHash hash) {
38
  if (n < 1) {
39
    return nullptr;
40
  }
41
  char *p{buffer + n};
42
  *--p = '\0';
43
  while (hash > 1) {
44
    if (p < buffer) {
45
      return nullptr;
46
    }
47
    *--p = 'A' + (hash % 26);
48
    hash /= 26;
49
  }
50
  return hash == 1 ? p : nullptr;
51
}
52

53
template <Direction DIR>
54
RT_API_ATTRS Cookie BeginInternalArrayListIO(const Descriptor &descriptor,
55
    void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
56
    const char *sourceFile, int sourceLine) {
57
  Terminator oom{sourceFile, sourceLine};
58
  return &New<InternalListIoStatementState<DIR>>{oom}(
59
      descriptor, sourceFile, sourceLine)
60
              .release()
61
              ->ioStatementState();
62
}
63

64
Cookie IODEF(BeginInternalArrayListOutput)(const Descriptor &descriptor,
65
    void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
66
    int sourceLine) {
67
  return BeginInternalArrayListIO<Direction::Output>(
68
      descriptor, scratchArea, scratchBytes, sourceFile, sourceLine);
69
}
70

71
Cookie IODEF(BeginInternalArrayListInput)(const Descriptor &descriptor,
72
    void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
73
    int sourceLine) {
74
  return BeginInternalArrayListIO<Direction::Input>(
75
      descriptor, scratchArea, scratchBytes, sourceFile, sourceLine);
76
}
77

78
template <Direction DIR>
79
RT_API_ATTRS Cookie BeginInternalArrayFormattedIO(const Descriptor &descriptor,
80
    const char *format, std::size_t formatLength,
81
    const Descriptor *formatDescriptor, void ** /*scratchArea*/,
82
    std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
83
  Terminator oom{sourceFile, sourceLine};
84
  return &New<InternalFormattedIoStatementState<DIR>>{oom}(descriptor, format,
85
      formatLength, formatDescriptor, sourceFile, sourceLine)
86
              .release()
87
              ->ioStatementState();
88
}
89

90
Cookie IODEF(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,
91
    const char *format, std::size_t formatLength,
92
    const Descriptor *formatDescriptor, void **scratchArea,
93
    std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
94
  return BeginInternalArrayFormattedIO<Direction::Output>(descriptor, format,
95
      formatLength, formatDescriptor, scratchArea, scratchBytes, sourceFile,
96
      sourceLine);
97
}
98

99
Cookie IODEF(BeginInternalArrayFormattedInput)(const Descriptor &descriptor,
100
    const char *format, std::size_t formatLength,
101
    const Descriptor *formatDescriptor, void **scratchArea,
102
    std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
103
  return BeginInternalArrayFormattedIO<Direction::Input>(descriptor, format,
104
      formatLength, formatDescriptor, scratchArea, scratchBytes, sourceFile,
105
      sourceLine);
106
}
107

108
template <Direction DIR>
109
RT_API_ATTRS Cookie BeginInternalListIO(
110
    std::conditional_t<DIR == Direction::Input, const char, char> *internal,
111
    std::size_t internalLength, void ** /*scratchArea*/,
112
    std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
113
  Terminator oom{sourceFile, sourceLine};
114
  return &New<InternalListIoStatementState<DIR>>{oom}(
115
      internal, internalLength, sourceFile, sourceLine)
116
              .release()
117
              ->ioStatementState();
118
}
119

120
Cookie IODEF(BeginInternalListOutput)(char *internal,
121
    std::size_t internalLength, void **scratchArea, std::size_t scratchBytes,
122
    const char *sourceFile, int sourceLine) {
123
  return BeginInternalListIO<Direction::Output>(internal, internalLength,
124
      scratchArea, scratchBytes, sourceFile, sourceLine);
125
}
126

127
Cookie IODEF(BeginInternalListInput)(const char *internal,
128
    std::size_t internalLength, void **scratchArea, std::size_t scratchBytes,
129
    const char *sourceFile, int sourceLine) {
130
  return BeginInternalListIO<Direction::Input>(internal, internalLength,
131
      scratchArea, scratchBytes, sourceFile, sourceLine);
132
}
133

134
template <Direction DIR>
135
RT_API_ATTRS Cookie BeginInternalFormattedIO(
136
    std::conditional_t<DIR == Direction::Input, const char, char> *internal,
137
    std::size_t internalLength, const char *format, std::size_t formatLength,
138
    const Descriptor *formatDescriptor, void ** /*scratchArea*/,
139
    std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
140
  Terminator oom{sourceFile, sourceLine};
141
  return &New<InternalFormattedIoStatementState<DIR>>{oom}(internal,
142
      internalLength, format, formatLength, formatDescriptor, sourceFile,
143
      sourceLine)
144
              .release()
145
              ->ioStatementState();
146
}
147

148
Cookie IODEF(BeginInternalFormattedOutput)(char *internal,
149
    std::size_t internalLength, const char *format, std::size_t formatLength,
150
    const Descriptor *formatDescriptor, void **scratchArea,
151
    std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
152
  return BeginInternalFormattedIO<Direction::Output>(internal, internalLength,
153
      format, formatLength, formatDescriptor, scratchArea, scratchBytes,
154
      sourceFile, sourceLine);
155
}
156

157
Cookie IODEF(BeginInternalFormattedInput)(const char *internal,
158
    std::size_t internalLength, const char *format, std::size_t formatLength,
159
    const Descriptor *formatDescriptor, void **scratchArea,
160
    std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
161
  return BeginInternalFormattedIO<Direction::Input>(internal, internalLength,
162
      format, formatLength, formatDescriptor, scratchArea, scratchBytes,
163
      sourceFile, sourceLine);
164
}
165

166
Cookie IODEF(BeginExternalListInput)(
167
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
168
  return BeginExternalListIO<Direction::Input, ExternalListIoStatementState>(
169
      unitNumber, sourceFile, sourceLine);
170
}
171

172
template <Direction DIR>
173
RT_API_ATTRS Cookie BeginExternalFormattedIO(const char *format,
174
    std::size_t formatLength, const Descriptor *formatDescriptor,
175
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
176
  Terminator terminator{sourceFile, sourceLine};
177
  Cookie errorCookie{nullptr};
178
  ExternalFileUnit *unit{GetOrCreateUnit(
179
      unitNumber, DIR, false /*!unformatted*/, terminator, errorCookie)};
180
  if (!unit) {
181
    return errorCookie;
182
  }
183
  Iostat iostat{IostatOk};
184
  if (!unit->isUnformatted.has_value()) {
185
    unit->isUnformatted = false;
186
  }
187
  if (*unit->isUnformatted) {
188
    iostat = IostatFormattedIoOnUnformattedUnit;
189
  }
190
  if (ChildIo * child{unit->GetChildIo()}) {
191
    if (iostat == IostatOk) {
192
      iostat = child->CheckFormattingAndDirection(false, DIR);
193
    }
194
    if (iostat == IostatOk) {
195
      return &child->BeginIoStatement<ChildFormattedIoStatementState<DIR>>(
196
          *child, format, formatLength, formatDescriptor, sourceFile,
197
          sourceLine);
198
    } else {
199
      return &child->BeginIoStatement<ErroneousIoStatementState>(
200
          iostat, nullptr /* no unit */, sourceFile, sourceLine);
201
    }
202
  } else {
203
    if (iostat == IostatOk) {
204
      iostat = unit->SetDirection(DIR);
205
    }
206
    if (iostat == IostatOk) {
207
      return &unit->BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
208
          terminator, *unit, format, formatLength, formatDescriptor, sourceFile,
209
          sourceLine);
210
    } else {
211
      return &unit->BeginIoStatement<ErroneousIoStatementState>(
212
          terminator, iostat, unit, sourceFile, sourceLine);
213
    }
214
  }
215
}
216

217
Cookie IODEF(BeginExternalFormattedOutput)(const char *format,
218
    std::size_t formatLength, const Descriptor *formatDescriptor,
219
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
220
  return BeginExternalFormattedIO<Direction::Output>(format, formatLength,
221
      formatDescriptor, unitNumber, sourceFile, sourceLine);
222
}
223

224
Cookie IODEF(BeginExternalFormattedInput)(const char *format,
225
    std::size_t formatLength, const Descriptor *formatDescriptor,
226
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
227
  return BeginExternalFormattedIO<Direction::Input>(format, formatLength,
228
      formatDescriptor, unitNumber, sourceFile, sourceLine);
229
}
230

231
template <Direction DIR>
232
RT_API_ATTRS Cookie BeginUnformattedIO(
233
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
234
  Terminator terminator{sourceFile, sourceLine};
235
  Cookie errorCookie{nullptr};
236
  ExternalFileUnit *unit{GetOrCreateUnit(
237
      unitNumber, DIR, true /*unformatted*/, terminator, errorCookie)};
238
  if (!unit) {
239
    return errorCookie;
240
  }
241
  Iostat iostat{IostatOk};
242
  if (!unit->isUnformatted.has_value()) {
243
    unit->isUnformatted = true;
244
  }
245
  if (!*unit->isUnformatted) {
246
    iostat = IostatUnformattedIoOnFormattedUnit;
247
  }
248
  if (ChildIo * child{unit->GetChildIo()}) {
249
    if (iostat == IostatOk) {
250
      iostat = child->CheckFormattingAndDirection(true, DIR);
251
    }
252
    if (iostat == IostatOk) {
253
      return &child->BeginIoStatement<ChildUnformattedIoStatementState<DIR>>(
254
          *child, sourceFile, sourceLine);
255
    } else {
256
      return &child->BeginIoStatement<ErroneousIoStatementState>(
257
          iostat, nullptr /* no unit */, sourceFile, sourceLine);
258
    }
259
  } else {
260
    if (iostat == IostatOk) {
261
      iostat = unit->SetDirection(DIR);
262
    }
263
    if (iostat == IostatOk) {
264
      IoStatementState &io{
265
          unit->BeginIoStatement<ExternalUnformattedIoStatementState<DIR>>(
266
              terminator, *unit, sourceFile, sourceLine)};
267
      if constexpr (DIR == Direction::Output) {
268
        if (unit->access == Access::Sequential) {
269
          // Create space for (sub)record header to be completed by
270
          // ExternalFileUnit::AdvanceRecord()
271
          unit->recordLength.reset(); // in case of prior BACKSPACE
272
          io.Emit("\0\0\0\0", 4); // placeholder for record length header
273
        }
274
      }
275
      return &io;
276
    } else {
277
      return &unit->BeginIoStatement<ErroneousIoStatementState>(
278
          terminator, iostat, unit, sourceFile, sourceLine);
279
    }
280
  }
281
}
282

283
Cookie IODEF(BeginUnformattedOutput)(
284
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
285
  return BeginUnformattedIO<Direction::Output>(
286
      unitNumber, sourceFile, sourceLine);
287
}
288

289
Cookie IODEF(BeginUnformattedInput)(
290
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
291
  return BeginUnformattedIO<Direction::Input>(
292
      unitNumber, sourceFile, sourceLine);
293
}
294

295
Cookie IODEF(BeginOpenUnit)( // OPEN(without NEWUNIT=)
296
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
297
  Terminator terminator{sourceFile, sourceLine};
298
  bool wasExtant{false};
299
  if (ExternalFileUnit *
300
      unit{ExternalFileUnit::LookUpOrCreate(
301
          unitNumber, terminator, wasExtant)}) {
302
    if (ChildIo * child{unit->GetChildIo()}) {
303
      return &child->BeginIoStatement<ErroneousIoStatementState>(
304
          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
305
          sourceLine);
306
    } else {
307
      return &unit->BeginIoStatement<OpenStatementState>(terminator, *unit,
308
          wasExtant, false /*not NEWUNIT=*/, sourceFile, sourceLine);
309
    }
310
  } else {
311
    return NoopUnit(terminator, unitNumber, IostatBadUnitNumber);
312
  }
313
}
314

315
Cookie IODEF(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
316
    const char *sourceFile, int sourceLine) {
317
  Terminator terminator{sourceFile, sourceLine};
318
  ExternalFileUnit &unit{
319
      ExternalFileUnit::NewUnit(terminator, false /*not child I/O*/)};
320
  return &unit.BeginIoStatement<OpenStatementState>(terminator, unit,
321
      false /*was an existing file*/, true /*NEWUNIT=*/, sourceFile,
322
      sourceLine);
323
}
324

325
Cookie IODEF(BeginWait)(ExternalUnit unitNumber, AsynchronousId id,
326
    const char *sourceFile, int sourceLine) {
327
  Terminator terminator{sourceFile, sourceLine};
328
  if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
329
    if (unit->Wait(id)) {
330
      return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,
331
          *unit, ExternalMiscIoStatementState::Wait, sourceFile, sourceLine);
332
    } else {
333
      return &unit->BeginIoStatement<ErroneousIoStatementState>(
334
          terminator, IostatBadWaitId, unit, sourceFile, sourceLine);
335
    }
336
  } else {
337
    return NoopUnit(
338
        terminator, unitNumber, id == 0 ? IostatOk : IostatBadWaitUnit);
339
  }
340
}
341
Cookie IODEF(BeginWaitAll)(
342
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
343
  return IONAME(BeginWait)(unitNumber, 0 /*no ID=*/, sourceFile, sourceLine);
344
}
345

346
Cookie IODEF(BeginClose)(
347
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
348
  Terminator terminator{sourceFile, sourceLine};
349
  if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
350
    if (ChildIo * child{unit->GetChildIo()}) {
351
      return &child->BeginIoStatement<ErroneousIoStatementState>(
352
          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
353
          sourceLine);
354
    }
355
  }
356
  if (ExternalFileUnit * unit{ExternalFileUnit::LookUpForClose(unitNumber)}) {
357
    return &unit->BeginIoStatement<CloseStatementState>(
358
        terminator, *unit, sourceFile, sourceLine);
359
  } else {
360
    // CLOSE(UNIT=bad unit) is just a no-op
361
    return NoopUnit(terminator, unitNumber);
362
  }
363
}
364

365
Cookie IODEF(BeginFlush)(
366
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
367
  Terminator terminator{sourceFile, sourceLine};
368
  if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
369
    if (ChildIo * child{unit->GetChildIo()}) {
370
      return &child->BeginIoStatement<ExternalMiscIoStatementState>(
371
          *unit, ExternalMiscIoStatementState::Flush, sourceFile, sourceLine);
372
    } else {
373
      return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,
374
          *unit, ExternalMiscIoStatementState::Flush, sourceFile, sourceLine);
375
    }
376
  } else {
377
    // FLUSH(UNIT=bad unit) is an error; an unconnected unit is a no-op
378
    return NoopUnit(terminator, unitNumber,
379
        unitNumber >= 0 ? IostatOk : IostatBadFlushUnit);
380
  }
381
}
382

383
Cookie IODEF(BeginBackspace)(
384
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
385
  Terminator terminator{sourceFile, sourceLine};
386
  if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
387
    if (ChildIo * child{unit->GetChildIo()}) {
388
      return &child->BeginIoStatement<ErroneousIoStatementState>(
389
          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
390
          sourceLine);
391
    } else {
392
      return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,
393
          *unit, ExternalMiscIoStatementState::Backspace, sourceFile,
394
          sourceLine);
395
    }
396
  } else {
397
    return NoopUnit(terminator, unitNumber, IostatBadBackspaceUnit);
398
  }
399
}
400

401
Cookie IODEF(BeginEndfile)(
402
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
403
  Terminator terminator{sourceFile, sourceLine};
404
  Cookie errorCookie{nullptr};
405
  if (ExternalFileUnit *
406
      unit{GetOrCreateUnit(unitNumber, Direction::Output,
407
          Fortran::common::nullopt, terminator, errorCookie)}) {
408
    if (ChildIo * child{unit->GetChildIo()}) {
409
      return &child->BeginIoStatement<ErroneousIoStatementState>(
410
          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
411
          sourceLine);
412
    } else {
413
      return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,
414
          *unit, ExternalMiscIoStatementState::Endfile, sourceFile, sourceLine);
415
    }
416
  } else {
417
    return errorCookie;
418
  }
419
}
420

421
Cookie IODEF(BeginRewind)(
422
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
423
  Terminator terminator{sourceFile, sourceLine};
424
  Cookie errorCookie{nullptr};
425
  if (ExternalFileUnit *
426
      unit{GetOrCreateUnit(unitNumber, Direction::Input,
427
          Fortran::common::nullopt, terminator, errorCookie)}) {
428
    if (ChildIo * child{unit->GetChildIo()}) {
429
      return &child->BeginIoStatement<ErroneousIoStatementState>(
430
          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
431
          sourceLine);
432
    } else {
433
      return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,
434
          *unit, ExternalMiscIoStatementState::Rewind, sourceFile, sourceLine);
435
    }
436
  } else {
437
    return errorCookie;
438
  }
439
}
440

441
Cookie IODEF(BeginInquireUnit)(
442
    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
443
  Terminator terminator{sourceFile, sourceLine};
444
  if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
445
    if (ChildIo * child{unit->GetChildIo()}) {
446
      return &child->BeginIoStatement<InquireUnitState>(
447
          *unit, sourceFile, sourceLine);
448
    } else {
449
      return &unit->BeginIoStatement<InquireUnitState>(
450
          terminator, *unit, sourceFile, sourceLine);
451
    }
452
  } else {
453
    // INQUIRE(UNIT=unrecognized unit)
454
    return &New<InquireNoUnitState>{terminator}(
455
        sourceFile, sourceLine, unitNumber)
456
                .release()
457
                ->ioStatementState();
458
  }
459
}
460

461
Cookie IODEF(BeginInquireFile)(const char *path, std::size_t pathLength,
462
    const char *sourceFile, int sourceLine) {
463
  Terminator terminator{sourceFile, sourceLine};
464
  auto trimmed{SaveDefaultCharacter(
465
      path, TrimTrailingSpaces(path, pathLength), terminator)};
466
  if (ExternalFileUnit *
467
      unit{ExternalFileUnit::LookUp(
468
          trimmed.get(), Fortran::runtime::strlen(trimmed.get()))}) {
469
    // INQUIRE(FILE=) to a connected unit
470
    if (ChildIo * child{unit->GetChildIo()}) {
471
      return &child->BeginIoStatement<InquireUnitState>(
472
          *unit, sourceFile, sourceLine);
473
    } else {
474
      return &unit->BeginIoStatement<InquireUnitState>(
475
          terminator, *unit, sourceFile, sourceLine);
476
    }
477
  } else {
478
    return &New<InquireUnconnectedFileState>{terminator}(
479
        std::move(trimmed), sourceFile, sourceLine)
480
                .release()
481
                ->ioStatementState();
482
  }
483
}
484

485
Cookie IODEF(BeginInquireIoLength)(const char *sourceFile, int sourceLine) {
486
  Terminator oom{sourceFile, sourceLine};
487
  return &New<InquireIOLengthState>{oom}(sourceFile, sourceLine)
488
              .release()
489
              ->ioStatementState();
490
}
491

492
// Control list items
493

494
void IODEF(EnableHandlers)(Cookie cookie, bool hasIoStat, bool hasErr,
495
    bool hasEnd, bool hasEor, bool hasIoMsg) {
496
  IoErrorHandler &handler{cookie->GetIoErrorHandler()};
497
  if (hasIoStat) {
498
    handler.HasIoStat();
499
  }
500
  if (hasErr) {
501
    handler.HasErrLabel();
502
  }
503
  if (hasEnd) {
504
    handler.HasEndLabel();
505
  }
506
  if (hasEor) {
507
    handler.HasEorLabel();
508
  }
509
  if (hasIoMsg) {
510
    handler.HasIoMsg();
511
  }
512
}
513

514
static RT_API_ATTRS bool YesOrNo(const char *keyword, std::size_t length,
515
    const char *what, IoErrorHandler &handler) {
516
  static const char *keywords[]{"YES", "NO", nullptr};
517
  switch (IdentifyValue(keyword, length, keywords)) {
518
  case 0:
519
    return true;
520
  case 1:
521
    return false;
522
  default:
523
    handler.SignalError(IostatErrorInKeyword, "Invalid %s='%.*s'", what,
524
        static_cast<int>(length), keyword);
525
    return false;
526
  }
527
}
528

529
bool IODEF(SetAdvance)(Cookie cookie, const char *keyword, std::size_t length) {
530
  IoStatementState &io{*cookie};
531
  IoErrorHandler &handler{io.GetIoErrorHandler()};
532
  bool nonAdvancing{!YesOrNo(keyword, length, "ADVANCE", handler)};
533
  if (nonAdvancing && io.GetConnectionState().access == Access::Direct) {
534
    handler.SignalError("Non-advancing I/O attempted on direct access file");
535
  } else {
536
    auto *unit{io.GetExternalFileUnit()};
537
    if (unit && unit->GetChildIo()) {
538
      // ADVANCE= is ignored for child I/O (12.6.4.8.3 p3)
539
    } else {
540
      io.mutableModes().nonAdvancing = nonAdvancing;
541
    }
542
  }
543
  return !handler.InError();
544
}
545

546
bool IODEF(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) {
547
  IoStatementState &io{*cookie};
548
  static const char *keywords[]{"NULL", "ZERO", nullptr};
549
  switch (IdentifyValue(keyword, length, keywords)) {
550
  case 0:
551
    io.mutableModes().editingFlags &= ~blankZero;
552
    return true;
553
  case 1:
554
    io.mutableModes().editingFlags |= blankZero;
555
    return true;
556
  default:
557
    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
558
        "Invalid BLANK='%.*s'", static_cast<int>(length), keyword);
559
    return false;
560
  }
561
}
562

563
bool IODEF(SetDecimal)(Cookie cookie, const char *keyword, std::size_t length) {
564
  IoStatementState &io{*cookie};
565
  static const char *keywords[]{"COMMA", "POINT", nullptr};
566
  switch (IdentifyValue(keyword, length, keywords)) {
567
  case 0:
568
    io.mutableModes().editingFlags |= decimalComma;
569
    return true;
570
  case 1:
571
    io.mutableModes().editingFlags &= ~decimalComma;
572
    return true;
573
  default:
574
    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
575
        "Invalid DECIMAL='%.*s'", static_cast<int>(length), keyword);
576
    return false;
577
  }
578
}
579

580
bool IODEF(SetDelim)(Cookie cookie, const char *keyword, std::size_t length) {
581
  IoStatementState &io{*cookie};
582
  static const char *keywords[]{"APOSTROPHE", "QUOTE", "NONE", nullptr};
583
  switch (IdentifyValue(keyword, length, keywords)) {
584
  case 0:
585
    io.mutableModes().delim = '\'';
586
    return true;
587
  case 1:
588
    io.mutableModes().delim = '"';
589
    return true;
590
  case 2:
591
    io.mutableModes().delim = '\0';
592
    return true;
593
  default:
594
    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
595
        "Invalid DELIM='%.*s'", static_cast<int>(length), keyword);
596
    return false;
597
  }
598
}
599

600
bool IODEF(SetPad)(Cookie cookie, const char *keyword, std::size_t length) {
601
  IoStatementState &io{*cookie};
602
  IoErrorHandler &handler{io.GetIoErrorHandler()};
603
  io.mutableModes().pad = YesOrNo(keyword, length, "PAD", handler);
604
  return !handler.InError();
605
}
606

607
bool IODEF(SetPos)(Cookie cookie, std::int64_t pos) {
608
  IoStatementState &io{*cookie};
609
  IoErrorHandler &handler{io.GetIoErrorHandler()};
610
  if (auto *unit{io.GetExternalFileUnit()}) {
611
    return unit->SetStreamPos(pos, handler);
612
  } else if (!io.get_if<ErroneousIoStatementState>()) {
613
    handler.Crash("SetPos() called on internal unit");
614
  }
615
  return false;
616
}
617

618
bool IODEF(SetRec)(Cookie cookie, std::int64_t rec) {
619
  IoStatementState &io{*cookie};
620
  IoErrorHandler &handler{io.GetIoErrorHandler()};
621
  if (auto *unit{io.GetExternalFileUnit()}) {
622
    if (unit->GetChildIo()) {
623
      handler.SignalError(
624
          IostatBadOpOnChildUnit, "REC= specifier on child I/O");
625
    } else {
626
      unit->SetDirectRec(rec, handler);
627
    }
628
  } else if (!io.get_if<ErroneousIoStatementState>()) {
629
    handler.Crash("SetRec() called on internal unit");
630
  }
631
  return true;
632
}
633

634
bool IODEF(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
635
  IoStatementState &io{*cookie};
636
  static const char *keywords[]{"UP", "DOWN", "ZERO", "NEAREST", "COMPATIBLE",
637
      "PROCESSOR_DEFINED", nullptr};
638
  switch (IdentifyValue(keyword, length, keywords)) {
639
  case 0:
640
    io.mutableModes().round = decimal::RoundUp;
641
    return true;
642
  case 1:
643
    io.mutableModes().round = decimal::RoundDown;
644
    return true;
645
  case 2:
646
    io.mutableModes().round = decimal::RoundToZero;
647
    return true;
648
  case 3:
649
    io.mutableModes().round = decimal::RoundNearest;
650
    return true;
651
  case 4:
652
    io.mutableModes().round = decimal::RoundCompatible;
653
    return true;
654
  case 5:
655
    io.mutableModes().round = executionEnvironment.defaultOutputRoundingMode;
656
    return true;
657
  default:
658
    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
659
        "Invalid ROUND='%.*s'", static_cast<int>(length), keyword);
660
    return false;
661
  }
662
}
663

664
bool IODEF(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {
665
  IoStatementState &io{*cookie};
666
  static const char *keywords[]{
667
      "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", nullptr};
668
  switch (IdentifyValue(keyword, length, keywords)) {
669
  case 0:
670
    io.mutableModes().editingFlags |= signPlus;
671
    return true;
672
  case 1:
673
  case 2: // processor default is SS
674
    io.mutableModes().editingFlags &= ~signPlus;
675
    return true;
676
  default:
677
    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
678
        "Invalid SIGN='%.*s'", static_cast<int>(length), keyword);
679
    return false;
680
  }
681
}
682

683
bool IODEF(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {
684
  IoStatementState &io{*cookie};
685
  auto *open{io.get_if<OpenStatementState>()};
686
  if (!open) {
687
    if (!io.get_if<NoopStatementState>() &&
688
        !io.get_if<ErroneousIoStatementState>()) {
689
      io.GetIoErrorHandler().Crash(
690
          "SetAccess() called when not in an OPEN statement");
691
    }
692
    return false;
693
  } else if (open->completedOperation()) {
694
    io.GetIoErrorHandler().Crash(
695
        "SetAccess() called after GetNewUnit() for an OPEN statement");
696
  }
697
  static const char *keywords[]{
698
      "SEQUENTIAL", "DIRECT", "STREAM", "APPEND", nullptr};
699
  switch (IdentifyValue(keyword, length, keywords)) {
700
  case 0:
701
    open->set_access(Access::Sequential);
702
    break;
703
  case 1:
704
    open->set_access(Access::Direct);
705
    break;
706
  case 2:
707
    open->set_access(Access::Stream);
708
    break;
709
  case 3: // Sun Fortran extension ACCESS=APPEND: treat as if POSITION=APPEND
710
    open->set_position(Position::Append);
711
    break;
712
  default:
713
    open->SignalError(IostatErrorInKeyword, "Invalid ACCESS='%.*s'",
714
        static_cast<int>(length), keyword);
715
  }
716
  return true;
717
}
718

719
bool IODEF(SetAction)(Cookie cookie, const char *keyword, std::size_t length) {
720
  IoStatementState &io{*cookie};
721
  auto *open{io.get_if<OpenStatementState>()};
722
  if (!open) {
723
    if (!io.get_if<NoopStatementState>() &&
724
        !io.get_if<ErroneousIoStatementState>()) {
725
      io.GetIoErrorHandler().Crash(
726
          "SetAction() called when not in an OPEN statement");
727
    }
728
    return false;
729
  } else if (open->completedOperation()) {
730
    io.GetIoErrorHandler().Crash(
731
        "SetAction() called after GetNewUnit() for an OPEN statement");
732
  }
733
  Fortran::common::optional<Action> action;
734
  static const char *keywords[]{"READ", "WRITE", "READWRITE", nullptr};
735
  switch (IdentifyValue(keyword, length, keywords)) {
736
  case 0:
737
    action = Action::Read;
738
    break;
739
  case 1:
740
    action = Action::Write;
741
    break;
742
  case 2:
743
    action = Action::ReadWrite;
744
    break;
745
  default:
746
    open->SignalError(IostatErrorInKeyword, "Invalid ACTION='%.*s'",
747
        static_cast<int>(length), keyword);
748
    return false;
749
  }
750
  RUNTIME_CHECK(io.GetIoErrorHandler(), action.has_value());
751
  if (open->wasExtant()) {
752
    if ((*action != Action::Write) != open->unit().mayRead() ||
753
        (*action != Action::Read) != open->unit().mayWrite()) {
754
      open->SignalError("ACTION= may not be changed on an open unit");
755
    }
756
  }
757
  open->set_action(*action);
758
  return true;
759
}
760

761
bool IODEF(SetAsynchronous)(
762
    Cookie cookie, const char *keyword, std::size_t length) {
763
  IoStatementState &io{*cookie};
764
  IoErrorHandler &handler{io.GetIoErrorHandler()};
765
  bool isYes{YesOrNo(keyword, length, "ASYNCHRONOUS", handler)};
766
  if (auto *open{io.get_if<OpenStatementState>()}) {
767
    if (open->completedOperation()) {
768
      handler.Crash(
769
          "SetAsynchronous() called after GetNewUnit() for an OPEN statement");
770
    }
771
    open->unit().set_mayAsynchronous(isYes);
772
  } else if (auto *ext{io.get_if<ExternalIoStatementBase>()}) {
773
    if (isYes) {
774
      if (ext->unit().mayAsynchronous()) {
775
        ext->SetAsynchronous();
776
      } else {
777
        handler.SignalError(IostatBadAsynchronous);
778
      }
779
    }
780
  } else if (!io.get_if<NoopStatementState>() &&
781
      !io.get_if<ErroneousIoStatementState>()) {
782
    handler.Crash("SetAsynchronous() called when not in an OPEN or external "
783
                  "I/O statement");
784
  }
785
  return !handler.InError();
786
}
787

788
bool IODEF(SetCarriagecontrol)(
789
    Cookie cookie, const char *keyword, std::size_t length) {
790
  IoStatementState &io{*cookie};
791
  auto *open{io.get_if<OpenStatementState>()};
792
  if (!open) {
793
    if (!io.get_if<NoopStatementState>() &&
794
        !io.get_if<ErroneousIoStatementState>()) {
795
      io.GetIoErrorHandler().Crash(
796
          "SetCarriageControl() called when not in an OPEN statement");
797
    }
798
    return false;
799
  } else if (open->completedOperation()) {
800
    io.GetIoErrorHandler().Crash(
801
        "SetCarriageControl() called after GetNewUnit() for an OPEN statement");
802
  }
803
  static const char *keywords[]{"LIST", "FORTRAN", "NONE", nullptr};
804
  switch (IdentifyValue(keyword, length, keywords)) {
805
  case 0:
806
    return true;
807
  case 1:
808
  case 2:
809
    open->SignalError(IostatErrorInKeyword,
810
        "Unimplemented CARRIAGECONTROL='%.*s'", static_cast<int>(length),
811
        keyword);
812
    return false;
813
  default:
814
    open->SignalError(IostatErrorInKeyword, "Invalid CARRIAGECONTROL='%.*s'",
815
        static_cast<int>(length), keyword);
816
    return false;
817
  }
818
}
819

820
bool IODEF(SetConvert)(Cookie cookie, const char *keyword, std::size_t length) {
821
  IoStatementState &io{*cookie};
822
  auto *open{io.get_if<OpenStatementState>()};
823
  if (!open) {
824
    if (!io.get_if<NoopStatementState>() &&
825
        !io.get_if<ErroneousIoStatementState>()) {
826
      io.GetIoErrorHandler().Crash(
827
          "SetConvert() called when not in an OPEN statement");
828
    }
829
    return false;
830
  } else if (open->completedOperation()) {
831
    io.GetIoErrorHandler().Crash(
832
        "SetConvert() called after GetNewUnit() for an OPEN statement");
833
  }
834
  if (auto convert{GetConvertFromString(keyword, length)}) {
835
    open->set_convert(*convert);
836
    return true;
837
  } else {
838
    open->SignalError(IostatErrorInKeyword, "Invalid CONVERT='%.*s'",
839
        static_cast<int>(length), keyword);
840
    return false;
841
  }
842
}
843

844
bool IODEF(SetEncoding)(
845
    Cookie cookie, const char *keyword, std::size_t length) {
846
  IoStatementState &io{*cookie};
847
  auto *open{io.get_if<OpenStatementState>()};
848
  if (!open) {
849
    if (!io.get_if<NoopStatementState>() &&
850
        !io.get_if<ErroneousIoStatementState>()) {
851
      io.GetIoErrorHandler().Crash(
852
          "SetEncoding() called when not in an OPEN statement");
853
    }
854
    return false;
855
  } else if (open->completedOperation()) {
856
    io.GetIoErrorHandler().Crash(
857
        "SetEncoding() called after GetNewUnit() for an OPEN statement");
858
  }
859
  // Allow the encoding to be changed on an open unit -- it's
860
  // useful and safe.
861
  static const char *keywords[]{"UTF-8", "DEFAULT", nullptr};
862
  switch (IdentifyValue(keyword, length, keywords)) {
863
  case 0:
864
    open->unit().isUTF8 = true;
865
    break;
866
  case 1:
867
    open->unit().isUTF8 = false;
868
    break;
869
  default:
870
    open->SignalError(IostatErrorInKeyword, "Invalid ENCODING='%.*s'",
871
        static_cast<int>(length), keyword);
872
  }
873
  return true;
874
}
875

876
bool IODEF(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {
877
  IoStatementState &io{*cookie};
878
  auto *open{io.get_if<OpenStatementState>()};
879
  if (!open) {
880
    if (!io.get_if<NoopStatementState>() &&
881
        !io.get_if<ErroneousIoStatementState>()) {
882
      io.GetIoErrorHandler().Crash(
883
          "SetForm() called when not in an OPEN statement");
884
    }
885
  } else if (open->completedOperation()) {
886
    io.GetIoErrorHandler().Crash(
887
        "SetForm() called after GetNewUnit() for an OPEN statement");
888
  }
889
  static const char *keywords[]{"FORMATTED", "UNFORMATTED", nullptr};
890
  switch (IdentifyValue(keyword, length, keywords)) {
891
  case 0:
892
    open->set_isUnformatted(false);
893
    break;
894
  case 1:
895
    open->set_isUnformatted(true);
896
    break;
897
  default:
898
    open->SignalError(IostatErrorInKeyword, "Invalid FORM='%.*s'",
899
        static_cast<int>(length), keyword);
900
  }
901
  return true;
902
}
903

904
bool IODEF(SetPosition)(
905
    Cookie cookie, const char *keyword, std::size_t length) {
906
  IoStatementState &io{*cookie};
907
  auto *open{io.get_if<OpenStatementState>()};
908
  if (!open) {
909
    if (!io.get_if<NoopStatementState>() &&
910
        !io.get_if<ErroneousIoStatementState>()) {
911
      io.GetIoErrorHandler().Crash(
912
          "SetPosition() called when not in an OPEN statement");
913
    }
914
    return false;
915
  } else if (open->completedOperation()) {
916
    io.GetIoErrorHandler().Crash(
917
        "SetPosition() called after GetNewUnit() for an OPEN statement");
918
  }
919
  static const char *positions[]{"ASIS", "REWIND", "APPEND", nullptr};
920
  switch (IdentifyValue(keyword, length, positions)) {
921
  case 0:
922
    open->set_position(Position::AsIs);
923
    return true;
924
  case 1:
925
    open->set_position(Position::Rewind);
926
    return true;
927
  case 2:
928
    open->set_position(Position::Append);
929
    return true;
930
  default:
931
    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
932
        "Invalid POSITION='%.*s'", static_cast<int>(length), keyword);
933
  }
934
  return true;
935
}
936

937
bool IODEF(SetRecl)(Cookie cookie, std::size_t n) {
938
  IoStatementState &io{*cookie};
939
  auto *open{io.get_if<OpenStatementState>()};
940
  if (!open) {
941
    if (!io.get_if<NoopStatementState>() &&
942
        !io.get_if<ErroneousIoStatementState>()) {
943
      io.GetIoErrorHandler().Crash(
944
          "SetRecl() called when not in an OPEN statement");
945
    }
946
    return false;
947
  } else if (open->completedOperation()) {
948
    io.GetIoErrorHandler().Crash(
949
        "SetRecl() called after GetNewUnit() for an OPEN statement");
950
  }
951
  if (n <= 0) {
952
    io.GetIoErrorHandler().SignalError("RECL= must be greater than zero");
953
    return false;
954
  } else if (open->wasExtant() &&
955
      open->unit().openRecl.value_or(0) != static_cast<std::int64_t>(n)) {
956
    open->SignalError("RECL= may not be changed for an open unit");
957
    return false;
958
  } else {
959
    open->unit().openRecl = n;
960
    return true;
961
  }
962
}
963

964
bool IODEF(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
965
  IoStatementState &io{*cookie};
966
  if (auto *open{io.get_if<OpenStatementState>()}) {
967
    if (open->completedOperation()) {
968
      io.GetIoErrorHandler().Crash(
969
          "SetStatus() called after GetNewUnit() for an OPEN statement");
970
    }
971
    static const char *statuses[]{
972
        "OLD", "NEW", "SCRATCH", "REPLACE", "UNKNOWN", nullptr};
973
    switch (IdentifyValue(keyword, length, statuses)) {
974
    case 0:
975
      open->set_status(OpenStatus::Old);
976
      return true;
977
    case 1:
978
      open->set_status(OpenStatus::New);
979
      return true;
980
    case 2:
981
      open->set_status(OpenStatus::Scratch);
982
      return true;
983
    case 3:
984
      open->set_status(OpenStatus::Replace);
985
      return true;
986
    case 4:
987
      open->set_status(OpenStatus::Unknown);
988
      return true;
989
    default:
990
      io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
991
          "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
992
    }
993
    return false;
994
  }
995
  if (auto *close{io.get_if<CloseStatementState>()}) {
996
    static const char *statuses[]{"KEEP", "DELETE", nullptr};
997
    switch (IdentifyValue(keyword, length, statuses)) {
998
    case 0:
999
      close->set_status(CloseStatus::Keep);
1000
      return true;
1001
    case 1:
1002
      close->set_status(CloseStatus::Delete);
1003
      return true;
1004
    default:
1005
      io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
1006
          "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
1007
    }
1008
    return false;
1009
  }
1010
  if (io.get_if<NoopStatementState>() ||
1011
      io.get_if<ErroneousIoStatementState>()) {
1012
    return true; // don't bother validating STATUS= in a no-op CLOSE
1013
  }
1014
  io.GetIoErrorHandler().Crash(
1015
      "SetStatus() called when not in an OPEN or CLOSE statement");
1016
}
1017

1018
bool IODEF(SetFile)(Cookie cookie, const char *path, std::size_t chars) {
1019
  IoStatementState &io{*cookie};
1020
  if (auto *open{io.get_if<OpenStatementState>()}) {
1021
    if (open->completedOperation()) {
1022
      io.GetIoErrorHandler().Crash(
1023
          "SetFile() called after GetNewUnit() for an OPEN statement");
1024
    }
1025
    open->set_path(path, chars);
1026
    return true;
1027
  } else if (!io.get_if<NoopStatementState>() &&
1028
      !io.get_if<ErroneousIoStatementState>()) {
1029
    io.GetIoErrorHandler().Crash(
1030
        "SetFile() called when not in an OPEN statement");
1031
  }
1032
  return false;
1033
}
1034

1035
bool IODEF(GetNewUnit)(Cookie cookie, int &unit, int kind) {
1036
  IoStatementState &io{*cookie};
1037
  auto *open{io.get_if<OpenStatementState>()};
1038
  if (!open) {
1039
    if (!io.get_if<NoopStatementState>() &&
1040
        !io.get_if<ErroneousIoStatementState>()) {
1041
      io.GetIoErrorHandler().Crash(
1042
          "GetNewUnit() called when not in an OPEN statement");
1043
    }
1044
    return false;
1045
  } else if (!open->InError()) {
1046
    open->CompleteOperation();
1047
  }
1048
  if (open->InError()) {
1049
    // A failed OPEN(NEWUNIT=n) does not modify 'n'
1050
    return false;
1051
  }
1052
  std::int64_t result{open->unit().unitNumber()};
1053
  if (!SetInteger(unit, kind, result)) {
1054
    open->SignalError("GetNewUnit(): bad INTEGER kind(%d) or out-of-range "
1055
                      "value(%jd) for result",
1056
        kind, static_cast<std::intmax_t>(result));
1057
  }
1058
  return true;
1059
}
1060

1061
// Data transfers
1062

1063
bool IODEF(OutputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
1064
  return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
1065
}
1066

1067
bool IODEF(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
1068
  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1069
}
1070

1071
bool IODEF(InputInteger)(Cookie cookie, std::int64_t &n, int kind) {
1072
  if (!cookie->CheckFormattedStmtType<Direction::Input>("InputInteger")) {
1073
    return false;
1074
  }
1075
  StaticDescriptor<0> staticDescriptor;
1076
  Descriptor &descriptor{staticDescriptor.descriptor()};
1077
  descriptor.Establish(
1078
      TypeCategory::Integer, kind, reinterpret_cast<void *>(&n), 0);
1079
  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1080
}
1081

1082
bool IODEF(InputReal32)(Cookie cookie, float &x) {
1083
  if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal32")) {
1084
    return false;
1085
  }
1086
  StaticDescriptor<0> staticDescriptor;
1087
  Descriptor &descriptor{staticDescriptor.descriptor()};
1088
  descriptor.Establish(TypeCategory::Real, 4, reinterpret_cast<void *>(&x), 0);
1089
  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1090
}
1091

1092
bool IODEF(InputReal64)(Cookie cookie, double &x) {
1093
  if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal64")) {
1094
    return false;
1095
  }
1096
  StaticDescriptor<0> staticDescriptor;
1097
  Descriptor &descriptor{staticDescriptor.descriptor()};
1098
  descriptor.Establish(TypeCategory::Real, 8, reinterpret_cast<void *>(&x), 0);
1099
  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1100
}
1101

1102
bool IODEF(InputComplex32)(Cookie cookie, float z[2]) {
1103
  if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex32")) {
1104
    return false;
1105
  }
1106
  StaticDescriptor<0> staticDescriptor;
1107
  Descriptor &descriptor{staticDescriptor.descriptor()};
1108
  descriptor.Establish(
1109
      TypeCategory::Complex, 4, reinterpret_cast<void *>(z), 0);
1110
  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1111
}
1112

1113
bool IODEF(InputComplex64)(Cookie cookie, double z[2]) {
1114
  if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex64")) {
1115
    return false;
1116
  }
1117
  StaticDescriptor<0> staticDescriptor;
1118
  Descriptor &descriptor{staticDescriptor.descriptor()};
1119
  descriptor.Establish(
1120
      TypeCategory::Complex, 8, reinterpret_cast<void *>(z), 0);
1121
  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1122
}
1123

1124
bool IODEF(OutputCharacter)(
1125
    Cookie cookie, const char *x, std::size_t length, int kind) {
1126
  if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputCharacter")) {
1127
    return false;
1128
  }
1129
  StaticDescriptor<0> staticDescriptor;
1130
  Descriptor &descriptor{staticDescriptor.descriptor()};
1131
  descriptor.Establish(
1132
      kind, length, reinterpret_cast<void *>(const_cast<char *>(x)), 0);
1133
  return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
1134
}
1135

1136
bool IODEF(InputCharacter)(
1137
    Cookie cookie, char *x, std::size_t length, int kind) {
1138
  if (!cookie->CheckFormattedStmtType<Direction::Input>("InputCharacter")) {
1139
    return false;
1140
  }
1141
  StaticDescriptor<0> staticDescriptor;
1142
  Descriptor &descriptor{staticDescriptor.descriptor()};
1143
  descriptor.Establish(kind, length, reinterpret_cast<void *>(x), 0);
1144
  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1145
}
1146

1147
bool IODEF(InputAscii)(Cookie cookie, char *x, std::size_t length) {
1148
  return IONAME(InputCharacter)(cookie, x, length, 1);
1149
}
1150

1151
bool IODEF(InputLogical)(Cookie cookie, bool &truth) {
1152
  if (!cookie->CheckFormattedStmtType<Direction::Input>("InputLogical")) {
1153
    return false;
1154
  }
1155
  StaticDescriptor<0> staticDescriptor;
1156
  Descriptor &descriptor{staticDescriptor.descriptor()};
1157
  descriptor.Establish(
1158
      TypeCategory::Logical, sizeof truth, reinterpret_cast<void *>(&truth), 0);
1159
  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
1160
}
1161

1162
bool IODEF(OutputDerivedType)(Cookie cookie, const Descriptor &descriptor,
1163
    const NonTbpDefinedIoTable *table) {
1164
  return descr::DescriptorIO<Direction::Output>(*cookie, descriptor, table);
1165
}
1166

1167
bool IODEF(InputDerivedType)(Cookie cookie, const Descriptor &descriptor,
1168
    const NonTbpDefinedIoTable *table) {
1169
  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor, table);
1170
}
1171

1172
std::size_t IODEF(GetSize)(Cookie cookie) {
1173
  IoStatementState &io{*cookie};
1174
  IoErrorHandler &handler{io.GetIoErrorHandler()};
1175
  if (!handler.InError()) {
1176
    io.CompleteOperation();
1177
  }
1178
  if (const auto *formatted{
1179
          io.get_if<FormattedIoStatementState<Direction::Input>>()}) {
1180
    return formatted->GetEditDescriptorChars();
1181
  } else if (!io.get_if<NoopStatementState>() &&
1182
      !io.get_if<ErroneousIoStatementState>()) {
1183
    handler.Crash("GetIoSize() called for an I/O statement that is not a "
1184
                  "formatted READ()");
1185
  }
1186
  return 0;
1187
}
1188

1189
std::size_t IODEF(GetIoLength)(Cookie cookie) {
1190
  IoStatementState &io{*cookie};
1191
  IoErrorHandler &handler{io.GetIoErrorHandler()};
1192
  if (!handler.InError()) {
1193
    io.CompleteOperation();
1194
  }
1195
  if (const auto *inq{io.get_if<InquireIOLengthState>()}) {
1196
    return inq->bytes();
1197
  } else if (!io.get_if<NoopStatementState>() &&
1198
      !io.get_if<ErroneousIoStatementState>()) {
1199
    handler.Crash("GetIoLength() called for an I/O statement that is not "
1200
                  "INQUIRE(IOLENGTH=)");
1201
  }
1202
  return 0;
1203
}
1204

1205
void IODEF(GetIoMsg)(Cookie cookie, char *msg, std::size_t length) {
1206
  IoStatementState &io{*cookie};
1207
  IoErrorHandler &handler{io.GetIoErrorHandler()};
1208
  if (!handler.InError()) {
1209
    io.CompleteOperation();
1210
  }
1211
  if (handler.InError()) { // leave "msg" alone when no error
1212
    handler.GetIoMsg(msg, length);
1213
  }
1214
}
1215

1216
AsynchronousId IODEF(GetAsynchronousId)(Cookie cookie) {
1217
  IoStatementState &io{*cookie};
1218
  IoErrorHandler &handler{io.GetIoErrorHandler()};
1219
  if (auto *ext{io.get_if<ExternalIoStatementBase>()}) {
1220
    return ext->asynchronousID();
1221
  } else if (!io.get_if<NoopStatementState>() &&
1222
      !io.get_if<ErroneousIoStatementState>()) {
1223
    handler.Crash(
1224
        "GetAsynchronousId() called when not in an external I/O statement");
1225
  }
1226
  return 0;
1227
}
1228

1229
bool IODEF(InquireCharacter)(Cookie cookie, InquiryKeywordHash inquiry,
1230
    char *result, std::size_t length) {
1231
  IoStatementState &io{*cookie};
1232
  return io.Inquire(inquiry, result, length);
1233
}
1234

1235
bool IODEF(InquireLogical)(
1236
    Cookie cookie, InquiryKeywordHash inquiry, bool &result) {
1237
  IoStatementState &io{*cookie};
1238
  return io.Inquire(inquiry, result);
1239
}
1240

1241
bool IODEF(InquirePendingId)(Cookie cookie, AsynchronousId id, bool &result) {
1242
  IoStatementState &io{*cookie};
1243
  return io.Inquire(HashInquiryKeyword("PENDING"), id, result);
1244
}
1245

1246
bool IODEF(InquireInteger64)(
1247
    Cookie cookie, InquiryKeywordHash inquiry, std::int64_t &result, int kind) {
1248
  IoStatementState &io{*cookie};
1249
  std::int64_t n{0}; // safe "undefined" value
1250
  if (io.Inquire(inquiry, n)) {
1251
    if (SetInteger(result, kind, n)) {
1252
      return true;
1253
    }
1254
    io.GetIoErrorHandler().SignalError(
1255
        "InquireInteger64(): bad INTEGER kind(%d) or out-of-range "
1256
        "value(%jd) for result",
1257
        kind, static_cast<std::intmax_t>(n));
1258
  }
1259
  return false;
1260
}
1261

1262
template <typename INT>
1263
static RT_API_ATTRS enum Iostat CheckUnitNumberInRangeImpl(INT unit,
1264
    bool handleError, char *ioMsg, std::size_t ioMsgLength,
1265
    const char *sourceFile, int sourceLine) {
1266
  static_assert(sizeof(INT) >= sizeof(ExternalUnit),
1267
      "only intended to be used when the INT to ExternalUnit conversion is "
1268
      "narrowing");
1269
  if (unit != static_cast<ExternalUnit>(unit)) {
1270
    Terminator oom{sourceFile, sourceLine};
1271
    IoErrorHandler errorHandler{oom};
1272
    if (handleError) {
1273
      errorHandler.HasIoStat();
1274
      if (ioMsg) {
1275
        errorHandler.HasIoMsg();
1276
      }
1277
    }
1278
    // Only provide the bad unit number in the message if SignalError can print
1279
    // it accurately. Otherwise, the generic IostatUnitOverflow message will be
1280
    // used.
1281
    if constexpr (sizeof(INT) > sizeof(std::intmax_t)) {
1282
      errorHandler.SignalError(IostatUnitOverflow);
1283
    } else if (static_cast<std::intmax_t>(unit) == unit) {
1284
      errorHandler.SignalError(IostatUnitOverflow,
1285
          "UNIT number %jd is out of range", static_cast<std::intmax_t>(unit));
1286
    } else {
1287
      errorHandler.SignalError(IostatUnitOverflow);
1288
    }
1289
    if (ioMsg) {
1290
      errorHandler.GetIoMsg(ioMsg, ioMsgLength);
1291
    }
1292
    return static_cast<enum Iostat>(errorHandler.GetIoStat());
1293
  }
1294
  return IostatOk;
1295
}
1296

1297
enum Iostat IODEF(CheckUnitNumberInRange64)(std::int64_t unit, bool handleError,
1298
    char *ioMsg, std::size_t ioMsgLength, const char *sourceFile,
1299
    int sourceLine) {
1300
  return CheckUnitNumberInRangeImpl(
1301
      unit, handleError, ioMsg, ioMsgLength, sourceFile, sourceLine);
1302
}
1303

1304
#ifdef __SIZEOF_INT128__
1305
enum Iostat IODEF(CheckUnitNumberInRange128)(common::int128_t unit,
1306
    bool handleError, char *ioMsg, std::size_t ioMsgLength,
1307
    const char *sourceFile, int sourceLine) {
1308
  return CheckUnitNumberInRangeImpl(
1309
      unit, handleError, ioMsg, ioMsgLength, sourceFile, sourceLine);
1310
}
1311
#endif
1312

1313
RT_EXT_API_GROUP_END
1314
} // namespace Fortran::runtime::io
1315