1//===-- runtime/external-unit.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// Implemenation of ExternalFileUnit for RT_USE_PSEUDO_FILE_UNIT=0.
10//
11//===----------------------------------------------------------------------===//
12
13#include "io-error.h"
14#include "lock.h"
15#include "tools.h"
16#include "unit-map.h"
17#include "unit.h"
18
19// NOTE: the header files above may define OpenMP declare target
20// variables, so they have to be included unconditionally
21// so that the offload entries are consistent between host and device.
22#if !defined(RT_USE_PSEUDO_FILE_UNIT)
23
24#include <cstdio>
25#include <limits>
26
27namespace Fortran::runtime::io {
28
29// The per-unit data structures are created on demand so that Fortran I/O
30// should work without a Fortran main program.
31static Lock unitMapLock;
32static Lock createOpenLock;
33static UnitMap *unitMap{nullptr};
34
35void FlushOutputOnCrash(const Terminator &terminator) {
36 if (!defaultOutput && !errorOutput) {
37 return;
38 }
39 IoErrorHandler handler{terminator};
40 handler.HasIoStat(); // prevent nested crash if flush has error
41 CriticalSection critical{unitMapLock};
42 if (defaultOutput) {
43 defaultOutput->FlushOutput(handler);
44 }
45 if (errorOutput) {
46 errorOutput->FlushOutput(handler);
47 }
48}
49
50ExternalFileUnit *ExternalFileUnit::LookUp(int unit) {
51 return GetUnitMap().LookUp(unit);
52}
53
54ExternalFileUnit *ExternalFileUnit::LookUpOrCreate(
55 int unit, const Terminator &terminator, bool &wasExtant) {
56 return GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant);
57}
58
59ExternalFileUnit *ExternalFileUnit::LookUpOrCreateAnonymous(int unit,
60 Direction dir, Fortran::common::optional<bool> isUnformatted,
61 const Terminator &terminator) {
62 // Make sure that the returned anonymous unit has been opened
63 // not just created in the unitMap.
64 CriticalSection critical{createOpenLock};
65 bool exists{false};
66 ExternalFileUnit *result{
67 GetUnitMap().LookUpOrCreate(unit, terminator, exists)};
68 if (result && !exists) {
69 IoErrorHandler handler{terminator};
70 result->OpenAnonymousUnit(
71 dir == Direction::Input ? OpenStatus::Unknown : OpenStatus::Replace,
72 Action::ReadWrite, Position::Rewind, Convert::Unknown, handler);
73 result->isUnformatted = isUnformatted;
74 }
75 return result;
76}
77
78ExternalFileUnit *ExternalFileUnit::LookUp(
79 const char *path, std::size_t pathLen) {
80 return GetUnitMap().LookUp(path, pathLen);
81}
82
83ExternalFileUnit &ExternalFileUnit::CreateNew(
84 int unit, const Terminator &terminator) {
85 bool wasExtant{false};
86 ExternalFileUnit *result{
87 GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant)};
88 RUNTIME_CHECK(terminator, result && !wasExtant);
89 return *result;
90}
91
92ExternalFileUnit *ExternalFileUnit::LookUpForClose(int unit) {
93 return GetUnitMap().LookUpForClose(unit);
94}
95
96ExternalFileUnit &ExternalFileUnit::NewUnit(
97 const Terminator &terminator, bool forChildIo) {
98 ExternalFileUnit &unit{GetUnitMap().NewUnit(terminator)};
99 unit.createdForInternalChildIo_ = forChildIo;
100 return unit;
101}
102
103bool ExternalFileUnit::OpenUnit(Fortran::common::optional<OpenStatus> status,
104 Fortran::common::optional<Action> action, Position position,
105 OwningPtr<char> &&newPath, std::size_t newPathLength, Convert convert,
106 IoErrorHandler &handler) {
107 if (convert == Convert::Unknown) {
108 convert = executionEnvironment.conversion;
109 }
110 swapEndianness_ = convert == Convert::Swap ||
111 (convert == Convert::LittleEndian && !isHostLittleEndian) ||
112 (convert == Convert::BigEndian && isHostLittleEndian);
113 bool impliedClose{false};
114 if (IsConnected()) {
115 bool isSamePath{newPath.get() && path() && pathLength() == newPathLength &&
116 std::memcmp(path(), newPath.get(), newPathLength) == 0};
117 if (status && *status != OpenStatus::Old && isSamePath) {
118 handler.SignalError("OPEN statement for connected unit may not have "
119 "explicit STATUS= other than 'OLD'");
120 return impliedClose;
121 }
122 if (!newPath.get() || isSamePath) {
123 // OPEN of existing unit, STATUS='OLD' or unspecified, not new FILE=
124 newPath.reset();
125 return impliedClose;
126 }
127 // Otherwise, OPEN on open unit with new FILE= implies CLOSE
128 DoImpliedEndfile(handler);
129 FlushOutput(handler);
130 TruncateFrame(0, handler);
131 Close(CloseStatus::Keep, handler);
132 impliedClose = true;
133 }
134 if (newPath.get() && newPathLength > 0) {
135 if (const auto *already{
136 GetUnitMap().LookUp(newPath.get(), newPathLength)}) {
137 handler.SignalError(IostatOpenAlreadyConnected,
138 "OPEN(UNIT=%d,FILE='%.*s'): file is already connected to unit %d",
139 unitNumber_, static_cast<int>(newPathLength), newPath.get(),
140 already->unitNumber_);
141 return impliedClose;
142 }
143 }
144 set_path(std::move(newPath), newPathLength);
145 Open(status.value_or(OpenStatus::Unknown), action, position, handler);
146 auto totalBytes{knownSize()};
147 if (access == Access::Direct) {
148 if (!openRecl) {
149 handler.SignalError(IostatOpenBadRecl,
150 "OPEN(UNIT=%d,ACCESS='DIRECT'): record length is not known",
151 unitNumber());
152 } else if (*openRecl <= 0) {
153 handler.SignalError(IostatOpenBadRecl,
154 "OPEN(UNIT=%d,ACCESS='DIRECT',RECL=%jd): record length is invalid",
155 unitNumber(), static_cast<std::intmax_t>(*openRecl));
156 } else if (totalBytes && (*totalBytes % *openRecl != 0)) {
157 handler.SignalError(IostatOpenBadRecl,
158 "OPEN(UNIT=%d,ACCESS='DIRECT',RECL=%jd): record length is not an "
159 "even divisor of the file size %jd",
160 unitNumber(), static_cast<std::intmax_t>(*openRecl),
161 static_cast<std::intmax_t>(*totalBytes));
162 }
163 recordLength = openRecl;
164 }
165 endfileRecordNumber.reset();
166 currentRecordNumber = 1;
167 if (totalBytes && access == Access::Direct && openRecl.value_or(0) > 0) {
168 endfileRecordNumber = 1 + (*totalBytes / *openRecl);
169 }
170 if (position == Position::Append) {
171 if (totalBytes) {
172 frameOffsetInFile_ = *totalBytes;
173 }
174 if (access != Access::Stream) {
175 if (!endfileRecordNumber) {
176 // Fake it so that we can backspace relative from the end
177 endfileRecordNumber = std::numeric_limits<std::int64_t>::max() - 2;
178 }
179 currentRecordNumber = *endfileRecordNumber;
180 }
181 }
182 return impliedClose;
183}
184
185void ExternalFileUnit::OpenAnonymousUnit(
186 Fortran::common::optional<OpenStatus> status,
187 Fortran::common::optional<Action> action, Position position,
188 Convert convert, IoErrorHandler &handler) {
189 // I/O to an unconnected unit reads/creates a local file, e.g. fort.7
190 std::size_t pathMaxLen{32};
191 auto path{SizedNew<char>{handler}(pathMaxLen)};
192 std::snprintf(path.get(), pathMaxLen, "fort.%d", unitNumber_);
193 OpenUnit(status, action, position, std::move(path), std::strlen(path.get()),
194 convert, handler);
195}
196
197void ExternalFileUnit::CloseUnit(CloseStatus status, IoErrorHandler &handler) {
198 DoImpliedEndfile(handler);
199 FlushOutput(handler);
200 Close(status, handler);
201}
202
203void ExternalFileUnit::DestroyClosed() {
204 GetUnitMap().DestroyClosed(*this); // destroys *this
205}
206
207Iostat ExternalFileUnit::SetDirection(Direction direction) {
208 if (direction == Direction::Input) {
209 if (mayRead()) {
210 direction_ = Direction::Input;
211 return IostatOk;
212 } else {
213 return IostatReadFromWriteOnly;
214 }
215 } else {
216 if (mayWrite()) {
217 direction_ = Direction::Output;
218 return IostatOk;
219 } else {
220 return IostatWriteToReadOnly;
221 }
222 }
223}
224
225UnitMap &ExternalFileUnit::CreateUnitMap() {
226 Terminator terminator{__FILE__, __LINE__};
227 IoErrorHandler handler{terminator};
228 UnitMap &newUnitMap{*New<UnitMap>{terminator}().release()};
229
230 bool wasExtant{false};
231 ExternalFileUnit &out{*newUnitMap.LookUpOrCreate(
232 FORTRAN_DEFAULT_OUTPUT_UNIT, terminator, wasExtant)};
233 RUNTIME_CHECK(terminator, !wasExtant);
234 out.Predefine(1);
235 handler.SignalError(out.SetDirection(Direction::Output));
236 out.isUnformatted = false;
237 defaultOutput = &out;
238
239 ExternalFileUnit &in{*newUnitMap.LookUpOrCreate(
240 FORTRAN_DEFAULT_INPUT_UNIT, terminator, wasExtant)};
241 RUNTIME_CHECK(terminator, !wasExtant);
242 in.Predefine(0);
243 handler.SignalError(in.SetDirection(Direction::Input));
244 in.isUnformatted = false;
245 defaultInput = &in;
246
247 ExternalFileUnit &error{
248 *newUnitMap.LookUpOrCreate(FORTRAN_ERROR_UNIT, terminator, wasExtant)};
249 RUNTIME_CHECK(terminator, !wasExtant);
250 error.Predefine(2);
251 handler.SignalError(error.SetDirection(Direction::Output));
252 error.isUnformatted = false;
253 errorOutput = &error;
254
255 return newUnitMap;
256}
257
258// A back-up atexit() handler for programs that don't terminate with a main
259// program END or a STOP statement or other Fortran-initiated program shutdown,
260// such as programs with a C main() that terminate normally. It flushes all
261// external I/O units. It is registered once the first time that any external
262// I/O is attempted.
263static void CloseAllExternalUnits() {
264 IoErrorHandler handler{"Fortran program termination"};
265 ExternalFileUnit::CloseAll(handler);
266}
267
268UnitMap &ExternalFileUnit::GetUnitMap() {
269 if (unitMap) {
270 return *unitMap;
271 }
272 {
273 CriticalSection critical{unitMapLock};
274 if (unitMap) {
275 return *unitMap;
276 }
277 unitMap = &CreateUnitMap();
278 }
279 std::atexit(func: CloseAllExternalUnits);
280 return *unitMap;
281}
282
283void ExternalFileUnit::CloseAll(IoErrorHandler &handler) {
284 CriticalSection critical{unitMapLock};
285 if (unitMap) {
286 unitMap->CloseAll(handler);
287 FreeMemoryAndNullify(unitMap);
288 }
289 defaultOutput = nullptr;
290 defaultInput = nullptr;
291 errorOutput = nullptr;
292}
293
294void ExternalFileUnit::FlushAll(IoErrorHandler &handler) {
295 CriticalSection critical{unitMapLock};
296 if (unitMap) {
297 unitMap->FlushAll(handler);
298 }
299}
300
301int ExternalFileUnit::GetAsynchronousId(IoErrorHandler &handler) {
302 if (!mayAsynchronous()) {
303 handler.SignalError(IostatBadAsynchronous);
304 return -1;
305 } else {
306 for (int j{0}; 64 * j < maxAsyncIds; ++j) {
307 if (auto least{asyncIdAvailable_[j].LeastElement()}) {
308 asyncIdAvailable_[j].reset(*least);
309 return 64 * j + static_cast<int>(*least);
310 }
311 }
312 handler.SignalError(IostatTooManyAsyncOps);
313 return -1;
314 }
315}
316
317bool ExternalFileUnit::Wait(int id) {
318 if (static_cast<std::size_t>(id) >= maxAsyncIds ||
319 asyncIdAvailable_[id / 64].test(id % 64)) {
320 return false;
321 } else {
322 if (id == 0) { // means "all IDs"
323 for (int j{0}; 64 * j < maxAsyncIds; ++j) {
324 asyncIdAvailable_[j].set();
325 }
326 asyncIdAvailable_[0].reset(0);
327 } else {
328 asyncIdAvailable_[id / 64].set(id % 64);
329 }
330 return true;
331 }
332}
333
334} // namespace Fortran::runtime::io
335
336#endif // !defined(RT_USE_PSEUDO_FILE_UNIT)
337

source code of flang/runtime/external-unit.cpp