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

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