xref: /llvm-project/flang/runtime/external-unit.cpp (revision 2326a02357c74a1a913a3d572bf789d4d48af7f0) 
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 
27 namespace 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.
31 static Lock unitMapLock;
32 static Lock createOpenLock;
33 static UnitMap *unitMap{nullptr};
34 
35 void 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 
50 ExternalFileUnit *ExternalFileUnit::LookUp(int unit) {
51   return GetUnitMap().LookUp(unit);
52 }
53 
54 ExternalFileUnit *ExternalFileUnit::LookUpOrCreate(
55     int unit, const Terminator &terminator, bool &wasExtant) {
56   return GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant);
57 }
58 
59 ExternalFileUnit *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 
87 ExternalFileUnit *ExternalFileUnit::LookUp(
88     const char *path, std::size_t pathLen) {
89   return GetUnitMap().LookUp(path, pathLen);
90 }
91 
92 ExternalFileUnit &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 
101 ExternalFileUnit *ExternalFileUnit::LookUpForClose(int unit) {
102   return GetUnitMap().LookUpForClose(unit);
103 }
104 
105 ExternalFileUnit &ExternalFileUnit::NewUnit(
106     const Terminator &terminator, bool forChildIo) {
107   ExternalFileUnit &unit{GetUnitMap().NewUnit(terminator)};
108   unit.createdForInternalChildIo_ = forChildIo;
109   return unit;
110 }
111 
112 bool 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 
197 bool 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 
210 void ExternalFileUnit::CloseUnit(CloseStatus status, IoErrorHandler &handler) {
211   DoImpliedEndfile(handler);
212   FlushOutput(handler);
213   Close(status, handler);
214 }
215 
216 void ExternalFileUnit::DestroyClosed() {
217   GetUnitMap().DestroyClosed(*this); // destroys *this
218 }
219 
220 Iostat 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 
245 UnitMap &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.
283 static void CloseAllExternalUnits() {
284   IoErrorHandler handler{"Fortran program termination"};
285   ExternalFileUnit::CloseAll(handler);
286 }
287 
288 UnitMap &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(CloseAllExternalUnits);
300   return *unitMap;
301 }
302 
303 void 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 
314 void ExternalFileUnit::FlushAll(IoErrorHandler &handler) {
315   CriticalSection critical{unitMapLock};
316   if (unitMap) {
317     unitMap->FlushAll(handler);
318   }
319 }
320 
321 int 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 
337 bool 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