1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
//===-- runtime/descriptor-io.cpp -----------------------------------------===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
#include "descriptor-io.h"
namespace Fortran::runtime::io::descr {
// User-defined derived type formatted I/O (maybe)
std::optional<bool> DefinedFormattedIo(IoStatementState &io,
const Descriptor &descriptor, const typeInfo::SpecialBinding &special) {
std::optional<DataEdit> peek{io.GetNextDataEdit(0 /*to peek at it*/)};
if (peek &&
(peek->descriptor == DataEdit::DefinedDerivedType ||
peek->descriptor == DataEdit::ListDirected)) {
// User-defined derived type formatting
IoErrorHandler &handler{io.GetIoErrorHandler()};
DataEdit edit{*io.GetNextDataEdit()}; // consume it this time
RUNTIME_CHECK(handler, edit.descriptor == peek->descriptor);
char ioType[2 + edit.maxIoTypeChars];
auto ioTypeLen{std::size_t{2} /*"DT"*/ + edit.ioTypeChars};
if (edit.descriptor == DataEdit::DefinedDerivedType) {
ioType[0] = 'D';
ioType[1] = 'T';
std::memcpy(ioType + 2, edit.ioType, edit.ioTypeChars);
} else {
std::strcpy(
ioType, io.mutableModes().inNamelist ? "NAMELIST" : "LISTDIRECTED");
ioTypeLen = std::strlen(ioType);
}
StaticDescriptor<1, true> statDesc;
Descriptor &vListDesc{statDesc.descriptor()};
vListDesc.Establish(TypeCategory::Integer, sizeof(int), nullptr, 1);
vListDesc.set_base_addr(edit.vList);
vListDesc.GetDimension(0).SetBounds(1, edit.vListEntries);
vListDesc.GetDimension(0).SetByteStride(
static_cast<SubscriptValue>(sizeof(int)));
ExternalFileUnit *actualExternal{io.GetExternalFileUnit()};
ExternalFileUnit *external{actualExternal};
if (!external) {
// Create a new unit to service defined I/O for an
// internal I/O parent.
external = &ExternalFileUnit::NewUnit(handler, true);
}
ChildIo &child{external->PushChildIo(io)};
int unit{external->unitNumber()};
int ioStat{IostatOk};
char ioMsg[100];
if (special.IsArgDescriptor(0)) {
auto *p{special.GetProc<void (*)(const Descriptor &, int &, char *,
const Descriptor &, int &, char *, std::size_t, std::size_t)>()};
p(descriptor, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,
sizeof ioMsg);
} else {
auto *p{special.GetProc<void (*)(const void *, int &, char *,
const Descriptor &, int &, char *, std::size_t, std::size_t)>()};
p(descriptor.raw().base_addr, unit, ioType, vListDesc, ioStat, ioMsg,
ioTypeLen, sizeof ioMsg);
}
handler.Forward(ioStat, ioMsg, sizeof ioMsg);
external->PopChildIo(child);
if (!actualExternal) {
// Close unit created for internal I/O above.
auto *closing{external->LookUpForClose(external->unitNumber())};
RUNTIME_CHECK(handler, external == closing);
external->DestroyClosed();
}
return handler.GetIoStat() == IostatOk;
} else {
// There's a user-defined I/O subroutine, but there's a FORMAT present and
// it does not have a DT data edit descriptor, so apply default formatting
// to the components of the derived type as usual.
return std::nullopt;
}
}
// User-defined derived type unformatted I/O
bool DefinedUnformattedIo(IoStatementState &io, const Descriptor &descriptor,
const typeInfo::SpecialBinding &special) {
// Unformatted I/O must have an external unit (or child thereof).
IoErrorHandler &handler{io.GetIoErrorHandler()};
ExternalFileUnit *external{io.GetExternalFileUnit()};
RUNTIME_CHECK(handler, external != nullptr);
ChildIo &child{external->PushChildIo(io)};
int unit{external->unitNumber()};
int ioStat{IostatOk};
char ioMsg[100];
if (special.IsArgDescriptor(0)) {
auto *p{special.GetProc<void (*)(
const Descriptor &, int &, int &, char *, std::size_t)>()};
p(descriptor, unit, ioStat, ioMsg, sizeof ioMsg);
} else {
auto *p{special.GetProc<void (*)(
const void *, int &, int &, char *, std::size_t)>()};
p(descriptor.raw().base_addr, unit, ioStat, ioMsg, sizeof ioMsg);
}
handler.Forward(ioStat, ioMsg, sizeof ioMsg);
external->PopChildIo(child);
return handler.GetIoStat() == IostatOk;
}
} // namespace Fortran::runtime::io::descr
|
