1 | //===-- runtime/descriptor-io.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 | #include "descriptor-io.h" |
10 | #include "flang/Common/restorer.h" |
11 | |
12 | namespace Fortran::runtime::io::descr { |
13 | |
14 | // Defined formatted I/O (maybe) |
15 | std::optional<bool> DefinedFormattedIo(IoStatementState &io, |
16 | const Descriptor &descriptor, const typeInfo::DerivedType &derived, |
17 | const typeInfo::SpecialBinding &special, |
18 | const SubscriptValue subscripts[]) { |
19 | std::optional<DataEdit> peek{io.GetNextDataEdit(maxRepeat: 0 /*to peek at it*/)}; |
20 | if (peek && |
21 | (peek->descriptor == DataEdit::DefinedDerivedType || |
22 | peek->descriptor == DataEdit::ListDirected)) { |
23 | // Defined formatting |
24 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
25 | DataEdit edit{*io.GetNextDataEdit(maxRepeat: 1)}; // now consume it; no repeats |
26 | RUNTIME_CHECK(handler, edit.descriptor == peek->descriptor); |
27 | char ioType[2 + edit.maxIoTypeChars]; |
28 | auto ioTypeLen{std::size_t{2} /*"DT"*/ + edit.ioTypeChars}; |
29 | if (edit.descriptor == DataEdit::DefinedDerivedType) { |
30 | ioType[0] = 'D'; |
31 | ioType[1] = 'T'; |
32 | std::memcpy(dest: ioType + 2, src: edit.ioType, n: edit.ioTypeChars); |
33 | } else { |
34 | std::strcpy( |
35 | dest: ioType, src: io.mutableModes().inNamelist ? "NAMELIST" : "LISTDIRECTED" ); |
36 | ioTypeLen = std::strlen(s: ioType); |
37 | } |
38 | StaticDescriptor<1, true> vListStatDesc; |
39 | Descriptor &vListDesc{vListStatDesc.descriptor()}; |
40 | vListDesc.Establish(TypeCategory::Integer, sizeof(int), nullptr, 1); |
41 | vListDesc.set_base_addr(edit.vList); |
42 | vListDesc.GetDimension(0).SetBounds(1, edit.vListEntries); |
43 | vListDesc.GetDimension(0).SetByteStride( |
44 | static_cast<SubscriptValue>(sizeof(int))); |
45 | ExternalFileUnit *actualExternal{io.GetExternalFileUnit()}; |
46 | ExternalFileUnit *external{actualExternal}; |
47 | if (!external) { |
48 | // Create a new unit to service defined I/O for an |
49 | // internal I/O parent. |
50 | external = &ExternalFileUnit::NewUnit(handler, true); |
51 | } |
52 | ChildIo &child{external->PushChildIo(io)}; |
53 | // Child formatted I/O is nonadvancing by definition (F'2018 12.6.2.4). |
54 | auto restorer{common::ScopedSet(io.mutableModes().nonAdvancing, true)}; |
55 | int unit{external->unitNumber()}; |
56 | int ioStat{IostatOk}; |
57 | char ioMsg[100]; |
58 | std::optional<std::int64_t> startPos; |
59 | if (edit.descriptor == DataEdit::DefinedDerivedType && |
60 | special.which() == typeInfo::SpecialBinding::Which::ReadFormatted) { |
61 | // DT is an edit descriptor so everything that the child |
62 | // I/O subroutine reads counts towards READ(SIZE=). |
63 | startPos = io.InquirePos(); |
64 | } |
65 | if (special.IsArgDescriptor(0)) { |
66 | // "dtv" argument is "class(t)", pass a descriptor |
67 | auto *p{special.GetProc<void (*)(const Descriptor &, int &, char *, |
68 | const Descriptor &, int &, char *, std::size_t, std::size_t)>()}; |
69 | StaticDescriptor<1, true, 10 /*?*/> elementStatDesc; |
70 | Descriptor &elementDesc{elementStatDesc.descriptor()}; |
71 | elementDesc.Establish( |
72 | derived, nullptr, 0, nullptr, CFI_attribute_pointer); |
73 | elementDesc.set_base_addr(descriptor.Element<char>(subscripts)); |
74 | p(elementDesc, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen, |
75 | sizeof ioMsg); |
76 | } else { |
77 | // "dtv" argument is "type(t)", pass a raw pointer |
78 | auto *p{special.GetProc<void (*)(const void *, int &, char *, |
79 | const Descriptor &, int &, char *, std::size_t, std::size_t)>()}; |
80 | p(descriptor.Element<char>(subscripts), unit, ioType, vListDesc, ioStat, |
81 | ioMsg, ioTypeLen, sizeof ioMsg); |
82 | } |
83 | handler.Forward(iostatOrErrno: ioStat, ioMsg, sizeof ioMsg); |
84 | external->PopChildIo(child); |
85 | if (!actualExternal) { |
86 | // Close unit created for internal I/O above. |
87 | auto *closing{external->LookUpForClose(unit: external->unitNumber())}; |
88 | RUNTIME_CHECK(handler, external == closing); |
89 | external->DestroyClosed(); |
90 | } |
91 | if (startPos) { |
92 | io.GotChar(io.InquirePos() - *startPos); |
93 | } |
94 | return handler.GetIoStat() == IostatOk; |
95 | } else { |
96 | // There's a defined I/O subroutine, but there's a FORMAT present and |
97 | // it does not have a DT data edit descriptor, so apply default formatting |
98 | // to the components of the derived type as usual. |
99 | return std::nullopt; |
100 | } |
101 | } |
102 | |
103 | // Defined unformatted I/O |
104 | bool DefinedUnformattedIo(IoStatementState &io, const Descriptor &descriptor, |
105 | const typeInfo::DerivedType &derived, |
106 | const typeInfo::SpecialBinding &special) { |
107 | // Unformatted I/O must have an external unit (or child thereof). |
108 | IoErrorHandler &handler{io.GetIoErrorHandler()}; |
109 | ExternalFileUnit *external{io.GetExternalFileUnit()}; |
110 | if (!external) { // INQUIRE(IOLENGTH=) |
111 | handler.SignalError(IostatNonExternalDefinedUnformattedIo); |
112 | return false; |
113 | } |
114 | ChildIo &child{external->PushChildIo(io)}; |
115 | int unit{external->unitNumber()}; |
116 | int ioStat{IostatOk}; |
117 | char ioMsg[100]; |
118 | std::size_t numElements{descriptor.Elements()}; |
119 | SubscriptValue subscripts[maxRank]; |
120 | descriptor.GetLowerBounds(subscripts); |
121 | if (special.IsArgDescriptor(0)) { |
122 | // "dtv" argument is "class(t)", pass a descriptor |
123 | auto *p{special.GetProc<void (*)( |
124 | const Descriptor &, int &, int &, char *, std::size_t)>()}; |
125 | StaticDescriptor<1, true, 10 /*?*/> elementStatDesc; |
126 | Descriptor &elementDesc{elementStatDesc.descriptor()}; |
127 | elementDesc.Establish(derived, nullptr, 0, nullptr, CFI_attribute_pointer); |
128 | for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) { |
129 | elementDesc.set_base_addr(descriptor.Element<char>(subscripts)); |
130 | p(elementDesc, unit, ioStat, ioMsg, sizeof ioMsg); |
131 | if (ioStat != IostatOk) { |
132 | break; |
133 | } |
134 | } |
135 | } else { |
136 | // "dtv" argument is "type(t)", pass a raw pointer |
137 | auto *p{special.GetProc<void (*)( |
138 | const void *, int &, int &, char *, std::size_t)>()}; |
139 | for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) { |
140 | p(descriptor.Element<char>(subscripts), unit, ioStat, ioMsg, |
141 | sizeof ioMsg); |
142 | if (ioStat != IostatOk) { |
143 | break; |
144 | } |
145 | } |
146 | } |
147 | handler.Forward(iostatOrErrno: ioStat, ioMsg, sizeof ioMsg); |
148 | external->PopChildIo(child); |
149 | return handler.GetIoStat() == IostatOk; |
150 | } |
151 | |
152 | } // namespace Fortran::runtime::io::descr |
153 | |